################################################################################
##
##  simpcomp / blowups.gi
##
##  Functions for bistellar moves  
##
##  $Id: bistellar.gi 68 2010-04-23 14:08:15Z jonathan $
##
################################################################################

SCIntFunc.MapBoundaries:=function(lk,bd,pseudomanifold,singularity)

	local tmp,element,i,j,n,iso,c,
		dim_A,det_A,faces_A,F_A,F_B,
		mainDim,mainComplex,mainF,minComplex,
		raw_options,validOptions,options,randomelement,rounds,no_options_flag,
		flipsInBoundary,flipsInComplex,projectedFlips,validFlips	,
		heating,relaxation,f_min,F_min,ready_flag,numVerts,reduce,ctr;
	
	iso:=SCIsomorphism(bd,lk);
	if iso = fail then
		return fail;
	fi;
		
	# if boundaries are already isomorphic return isomorphism
	if iso <> [] then
		Info(InfoSimpcomp,1,"SCBlowup: boundaries isomorphic, no PL-homeomorphism needed, continuing...");
		return [iso,pseudomanifold];
	fi;
	
	Info(InfoSimpcomp,1,"SCBlowup: boundaries not isomorphic, initializing bistellar moves...");
	
	raw_options:=[];
	validOptions := [];
	# list of actual options for bistellar moves
	options:=[];
	# one element of options -> randomelement := [[element],[linkface]]
	randomelement:=[];
	# TECHNICAL VARIABLES #
	# number of rounds executed
	rounds:=0;
	# is set to "1" if no bistellar operations are left
	no_options_flag:=0;
	
	# comlpex A: lk
	dim_A:=SCDim(lk);
	det_A:=SCAltshulerSteinberg(lk);
	faces_A:=SCFaceLattice(lk);
	F_A:=SCFVector(lk);	
	if dim_A = fail or faces_A = fail or det_A = fail or F_A = fail then
		return fail;
	fi;
	
	# comlpex B: bd
	F_B:=SCFVector(bd);	
	if F_B = fail then
		return fail;
	fi;
	
	# main object: pseudomanifold
	# make face lattice and f-vector mutable
	mainComplex := ShallowCopy(SCFaceLattice(pseudomanifold));
	mainComplex:=List(mainComplex,x->ShallowCopy(x));
	mainF := ShallowCopy(SCFVector(pseudomanifold));
	numVerts := mainF[1];
	mainDim := SCDim(pseudomanifold);
	if mainComplex = fail or mainF = fail or mainDim = fail then
		return fail;
	fi;
	
	#############################################
	#                                           #
	#                                           #
	#   computing initial options for moves     #
	#                                           #
	#                                           #
	#############################################
	reduce := false;
	rounds:=1;
	f_min := ShallowCopy(F_A);
	minComplex:=SC(mainComplex[5]);
		
	while no_options_flag = 0 or rounds <= 100000 do
	
		### computing possible flips in complex ###
		flipsInComplex := [];
		for i in [0..mainDim] do
			flipsInComplex[i+1] := SCIntFunc.IRawBistellarRMoves(i,mainComplex,(mainDim+1));
		od;
		
		if not reduce then
			### computing possible flips in boundary ###
			flipsInBoundary := [];
			for i in [0..dim_A] do
				flipsInBoundary[i+1] := SCIntFunc.IRawBistellarRMoves(i,faces_A,(dim_A+1));
			od;
			# remove flips that DO NOT contain "singularity"
			tmp := [];
			n:=Size(flipsInComplex);
			for i in [1..n] do
				tmp[i] := [];
				for element in flipsInComplex[i] do
					if not singularity in element[1] and not singularity in element[2] then
						Add(tmp[i],element);
					fi;
				od;
			od;
			for i in [1..n] do
				flipsInComplex[i] := Difference(flipsInComplex[i],tmp[i]);
			od;
		else	
			# remove flips that DO contain "singularity"
			tmp := [];
			n:=Size(flipsInComplex);
			for i in [1..n] do
				tmp[i] := [];
				for element in flipsInComplex[i] do
					if singularity in element[1] or singularity in element[2] then
						Add(tmp[i],element);
					fi;
				od;
			od;
			for i in [1..n] do
				flipsInComplex[i] := Difference(flipsInComplex[i],tmp[i]);
			od;
		fi;
		
		# remove flips that aren't valid
		validFlips := [];
		for i in [0..mainDim] do
			validFlips[i+1] := SCIntFunc.IBistellarRMoves(i,(mainDim+1),flipsInComplex[i+1],mainComplex);
		od;
		flipsInComplex := ShallowCopy(validFlips);
		
		if not reduce then
			# compute projected flips
			projectedFlips := [];
			for i in [1..Size(flipsInComplex)] do
				projectedFlips[i] := [];
				for element in flipsInComplex[i] do
					tmp := [ Difference(element[1],[singularity]) , Difference(element[2],[singularity]) ];
					Add(projectedFlips[i],tmp);
				od;
			od;
			# computing intersection of projectedFlips and flipsInBoundary
			raw_options := [];
			for i in [1..Size(flipsInBoundary)] do
				raw_options[i] := [];
				for element in flipsInBoundary[i] do
					if element in projectedFlips[i] then
						Add(raw_options[i],element);
					fi;
				od;
			od;
		else
			raw_options := ShallowCopy(flipsInComplex);
		fi;
	
		### initial parameters ###
		heating:=0;
		relaxation:=0;
		if reduce then
			ctr:=0;
		fi;
		
		while no_options_flag = 0 and rounds <= 100000 do    
			### strategy for selecting options ###
			options:=[];
			if reduce then
				ctr:=ctr+1;
			fi;
			
			if reduce and (mainF[1] < 3/2*numVerts or ctr >= 5000) then
				reduce := false;
				# main object: pseudomanifold
				# make face lattice and f-vector mutable
				mainComplex := ShallowCopy(SCFaceLattice(minComplex));
				mainComplex:=List(mainComplex,x->ShallowCopy(x));
				mainF := ShallowCopy(SCFVector(minComplex));
				mainDim := SCDim(minComplex);
				if mainComplex = fail or mainF = fail or mainDim = fail then
					return fail;
				fi;
				lk:=SCLink(minComplex,singularity);
				dim_A:=SCDim(lk);
				det_A:=SCAltshulerSteinberg(lk);
				faces_A:=SCFaceLattice(lk);
				F_A:=SCFVector(lk);	
				if dim_A = fail or faces_A = fail or det_A = fail or F_A = fail then
					return fail;
				fi;
				break;
			fi;
			
			if not reduce and mainF[1] > 3*numVerts then
				reduce := true;
				# main object: pseudomanifold
				# make face lattice and f-vector mutable
				mainComplex := ShallowCopy(SCFaceLattice(minComplex));
				mainComplex:=List(mainComplex,x->ShallowCopy(x));
				mainF := ShallowCopy(SCFVector(minComplex));
				F_min := ShallowCopy(mainF);
				mainDim := SCDim(minComplex);
				if mainComplex = fail or mainF = fail or mainDim = fail then
					return fail;
				fi;
				break;
			fi;
			
			if not reduce then
				
				if heating > 0 then
					if IsInt(heating/15) = true and f_min > F_B then
						tmp := SCIntFunc.IBistellarRMoves(0,(dim_A+1),raw_options[1],faces_A);
						Append(options,tmp);
					else
						tmp := SCIntFunc.IBistellarRMoves(1,(dim_A+1),raw_options[2],faces_A);
						Append(options,tmp);
						if options = [] then
							tmp := SCIntFunc.IBistellarRMoves(2,(dim_A+1),raw_options[3],faces_A);
							Append(options,tmp);
							heating:=0;
						fi;
					fi;
					heating:=heating-1;
				else
					tmp := SCIntFunc.IBistellarRMoves(3,(dim_A+1),raw_options[4],faces_A);
					Append(options,tmp);
					if options = [] then
						tmp := SCIntFunc.IBistellarRMoves(2,(dim_A+1),raw_options[3],faces_A);
						Append(options,tmp);
						if options = [] then
							tmp := SCIntFunc.IBistellarRMoves(1,(dim_A+1),raw_options[2],faces_A);
							Append(options,tmp);
							if relaxation = 10 then
								heating:=15;
								relaxation:=0;
							fi;
							relaxation:=relaxation+1;
							if options = [] then
								tmp := SCIntFunc.IBistellarRMoves(0,(dim_A+1),raw_options[1],faces_A);
								options := Union(options,tmp);
							fi;
						fi;
					fi;
				fi;
				
				# choosing move at random
				if no_options_flag <> 0 then
					Info(InfoSimpcomp,1,"SCBlowup: no valid flip found.");
					return fail;
				fi;
				# check, if possible options are available
				if options = [] then
					Info(InfoSimpcomp,1,"SCBlowup: no options left for bistellar moves...");
					return fail;
				fi;
				
				# chose move in boundary
				tmp:=RandomList(options);
				
				# check, if there's a corresponding move in the main complex
				ready_flag := 0;
				for i in [1..Size(flipsInComplex)] do
					if ready_flag = 0 then
						for element in flipsInComplex[i] do
							if IsSubset(element[1],tmp[1]) and IsSubset(element[2],tmp[2]) then
								randomelement := element;
								ready_flag := 1;
								break;
							fi;
						od;
					else
						break;
					fi;
				od;
				
				# re-check existence of randomelement in complex
				ready_flag := 0;
				for i in [1..Size(flipsInComplex)] do
					if Intersection(flipsInComplex[i],[randomelement]) <> [] then
						ready_flag := 1;
						break;
					fi;
				od;
					
			else
				
				if heating > 0 then
					if IsInt(heating/20) = true then
						 tmp := SCIntFunc.IBistellarRMoves(0,(mainDim+1),raw_options[1],mainComplex);
						 Append(options,tmp);
					else
						 tmp := SCIntFunc.IBistellarRMoves(1,(mainDim+1),raw_options[2],mainComplex);
						 Append(options,tmp);
						 tmp := SCIntFunc.IBistellarRMoves(2,(mainDim+1),raw_options[3],mainComplex);
						 Append(options,tmp);
						 if options = [] then
								tmp := SCIntFunc.IBistellarRMoves(3,(mainDim+1),raw_options[4],mainComplex);
								Append(options,tmp);
						 fi;
					fi;
					heating:=heating-1;
				else
					tmp := SCIntFunc.IBistellarRMoves(4,(mainDim+1),raw_options[5],mainComplex);
					Append(options,tmp);
					if options = [] then
						 tmp := SCIntFunc.IBistellarRMoves(3,(mainDim+1),raw_options[4],mainComplex);
						 Append(options,tmp);
						 if options = [] then
								tmp := SCIntFunc.IBistellarRMoves(1,(mainDim+1),raw_options[2],mainComplex);
								Append(options,tmp); 
								tmp := SCIntFunc.IBistellarRMoves(2,(mainDim+1),raw_options[3],mainComplex);
								Append(options,tmp); 
								if relaxation = 15 then 
									 heating:=20;
									 relaxation:=0;
								fi;
								relaxation:=relaxation+1;
								if options = [] then
									 tmp := SCIntFunc.IBistellarRMoves(0,(mainDim+1),raw_options[1],mainComplex);
									 Append(options,tmp);
								fi;
				
						 fi;
					fi;
				fi;
				
				# choosing move at random
				if no_options_flag <> 0 then
					Info(InfoSimpcomp,1,"SCBlowup: no valid flip found.");
					return fail;
				fi;
				# check, if possible options are available
				if options = [] then
					Info(InfoSimpcomp,1,"SCBlowup: no options left for bistellar moves...");
					return fail;
				fi;
				# chose move in boundary
				randomelement:=RandomList(options);
				ready_flag:=1;	
			fi;
			
			# if valid flip exists in complex perform flip
			if ready_flag <> 1 then
				Info(InfoSimpcomp,1,"SCBlowup: no valid flip found.");
				return fail;
			fi;
							
			tmp := SCIntFunc.Move((mainDim+1)-Length(randomelement[1]),
			(mainDim+1),mainComplex,mainF,randomelement,flipsInComplex,0,[]);
			mainComplex := tmp[1];
			mainF := tmp[2];
			flipsInComplex := tmp[3];
			Info(InfoSimpcomp,2,"SCBlowup: ",mainDim+1-Length(randomelement[1]),"-Move   (",rounds," rounds)");
			if reduce then
				Info(InfoSimpcomp,2,"SCBlowup: ",mainF);
			fi;
			
			if not reduce then
			
				# remove flips that DO NOT contain "singularity"
				tmp := [];
				for i in [1..Size(flipsInComplex)] do
					for element in flipsInComplex[i] do
						if not singularity in element[1] and not singularity in element[2] then
							Add(tmp,element);
						fi;
					od;
					flipsInComplex[i] := Difference(flipsInComplex[i],tmp);
				od;
			
			else
			
				# remove flips that DOES contain "singularity"
				tmp := [];
				for i in [1..Size(flipsInComplex)] do
					for element in flipsInComplex[i] do
						if singularity in element[1] or singularity in element[2] then
							Add(tmp,element);
						fi;
					od;
					flipsInComplex[i] := Difference(flipsInComplex[i],tmp);
				od;
			
			fi;
			
			# remove flips that aren't valid
			validFlips := [];
			for i in [0..mainDim] do
				validFlips[i+1] := SCIntFunc.IBistellarRMoves(i,(mainDim+1),flipsInComplex[i+1],mainComplex);
			od;
			flipsInComplex := ShallowCopy(validFlips);
			
			if not reduce then
				# compute projected flips
				projectedFlips := [];
				for i in [1..Size(flipsInComplex)] do
					projectedFlips[i] := [];
					for element in flipsInComplex[i] do
						tmp := [ Difference(element[1],[singularity]) , Difference(element[2],[singularity]) ];
						Add(projectedFlips[i],tmp);
					od;
				od;
								
				# update boundary
				c:=SCLink(SC(mainComplex[mainDim+1]),singularity);
				faces_A := SCFaceLattice(c); 
				F_A := SCFVector(c); 
				det_A := SCAltshulerSteinberg(c);
				dim_A := SCDim(c);
				
				if faces_A = fail or F_A = fail or det_A = fail or dim_A = fail then
					return fail;
				fi;
				
				### computing possible flips in boundary ###
				flipsInBoundary := [];
				for i in [0..dim_A] do
					flipsInBoundary[i+1] := SCIntFunc.IRawBistellarRMoves(i,faces_A,(dim_A+1));
				od;
				
				# computing intersection of projectedFlips and flipsInBoundary
				raw_options := [];
				for i in [1..Size(flipsInBoundary)] do
					raw_options[i] := [];
					for element in flipsInBoundary[i] do
						for j in [1..Size(projectedFlips)] do
							if element in projectedFlips[j] then
								Add(raw_options[i],element);
							fi;
						od;
					od;
				od;
				
				if F_A < f_min then
					f_min := ShallowCopy(F_A);
					minComplex:=SC(mainComplex[mainDim+1]);
					Info(InfoSimpcomp,1,"SCBlowup: found complex with smaller boundary: f = ",f_min,".");
				fi;
				
				Info(InfoSimpcomp,2,"SCBlowup: ",mainF," - ",F_A);
				
				
				###########################
				### test, if isomorphic ###
				###########################
				
				iso:=SCIsomorphism(bd,SC(faces_A[dim_A+1]));
				if iso = fail then
					return fail;
				fi;
				
				# if boundaries are isomorphic return isomorphism
				if iso <> [] then
					Info(InfoSimpcomp,1,"SCBlowup: found complex with isomorphic boundaries.");
					return [iso,minComplex];
				fi;
			else
				
				if mainF < F_min then
					F_min := ShallowCopy(mainF);
					minComplex:=SC(mainComplex[mainDim+1]);
					Info(InfoSimpcomp,1,"SCBlowup: reduced complex: f = ",F_min,".");
				fi;
			
				raw_options:=ShallowCopy(flipsInComplex);						
			fi;
			rounds:=rounds+1;
		od; # end: map boundaries
		
	od; # end: no_options_flag = 0 and rounds <= 100000
	
	
	Info(InfoSimpcomp,1,"SCBlowup: no flip sequence found, stopping.");
	return fail;

end;



################################################################################
##<#GAPDoc Label="SCBlowup">
## <ManSection>
## <Prop Name="SCBlowup" Arg="pseudomanifold,singularity[,mappingCyl]"/>
## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
## <Description>
## If <C>singularity</C> is an ordinary double point of a combinatorial <M>4</M>-pseudomanifold <Arg>pseudomanifold</Arg> (lk(<C>singularity</C><M>) = \mathbb{R}P^3</M>) the blowup of <C>pseudomanifold</C> at <C>singularity</C> is computed. If it is a singularity of type <M>S^2 \times S^1</M>, <M>S^2 \dtimes S^1</M> or <M>L(k,1)</M>, <M>k \leq 4</M>, the canonical resolution of <C>singularity</C> is computed using the bounded complexes provided in the source code below. <P/>
##
## If the optional argument <C>mappingCyl</C> of type <C>SCIsSimplicialComplex</C> is given, this complex will be used to to resolve the singularity <C>singularity</C>.<P/>
##
## Note that bistellar moves do not necessarily preserve any orientation. Thus, the orientation of the blowup has to be checked in order to verify which type of blowup was performed. Normally, repeated computation results in both versions.
## <Example>
## gap> SCLib.SearchByName("Kummer variety");
## [ [ 7488, "4-dimensional Kummer variety (VT)" ] ]
## gap> c:=SCLib.Load(last[1][1]);;                
## gap> d:= SCBlowup(c,1);
## #I  SCBlowup: checking if singularity is a combinatorial manifold...
## #I  SCBlowup: ...true
## #I  SCBlowup: checking type of singularity...
## #I  SCBlowup: ...ordinary double point (supported type).
## #I  SCBlowup: starting blowup...
## #I  SCBlowup: map boundaries...
## #I  SCBlowup: boundaries not isomorphic, initializing bistellar move sequence...
## #I  SCBlowup: found complex with smaller boundary: f = [ 15, 74, 118, 59 ].
## #I  SCBlowup: found complex with smaller boundary: f = [ 14, 70, 112, 56 ].
## #I  SCBlowup: found complex with smaller boundary: f = [ 14, 69, 110, 55 ].
## #I  SCBlowup: found complex with smaller boundary: f = [ 14, 68, 108, 54 ].
## #I  SCBlowup: found complex with smaller boundary: f = [ 13, 64, 102, 51 ].
## #I  SCBlowup: found complex with smaller boundary: f = [ 13, 63, 100, 50 ].
## #I  SCBlowup: found complex with smaller boundary: f = [ 13, 62, 98, 49 ].
## #I  SCBlowup: found complex with smaller boundary: f = [ 13, 61, 96, 48 ].
## #I  SCBlowup: found complex with smaller boundary: f = [ 13, 60, 94, 47 ].
## #I  SCBlowup: found complex with smaller boundary: f = [ 12, 56, 88, 44 ].
## #I  SCBlowup: found complex with smaller boundary: f = [ 11, 52, 82, 41 ].
## #I  SCBlowup: found complex with smaller boundary: f = [ 11, 51, 80, 40 ].
## #I  SCBlowup: found complex with isomorphic boundaries.
## #I  SCBlowup: ...boundaries mapped succesfully
## #I  SCBlowup: build complex...
## #I  SCBlowup: ...done.
## #I  SCBlowup: ...blowup completed.
## [SimplicialComplex
## 
##  Properties known: Dim, Facets, Name, SCVertices.
## 
##  Name="unnamed complex 5862"
##  Dim=4
## 
## /SimplicialComplex]
## </Example>
## <Example> NOEXECUTE
## gap> # resolving the singularities of a 4 dimensional Kummer variety
## gap> SCLib.SearchByName("Kummer variety");
## [ [ 7488, "4-dimensional Kummer variety (VT)" ] ]
## gap> c:=SCLib.Load(last[1][1]);;
## gap> for i in [1..16] do
##        for j in SCLabels(c) do 
##          lk:=SCLink(c,j);
##          if lk.Homology = [[0],[0],[0],[1]] then continue; fi; 
##          singularity := j; break;
##        od;
##        c:=SCBlowup(c,singularity); 
##      od;
## gap> d.IsManifold;
## true
## gap> d.Homology;
## [ [ 0, [ ] ], [ 0, [ ] ], [ 22, [ ] ], [ 0, [ ] ], [ 1, [ ] ] ]
## </Example>
## </Description>
## </ManSection>
##<#/GAPDoc>
################################################################################
InstallGlobalFunction(SCBlowup,
	function(arg)

	local pseudomanifold,singularity,
		equivalent,labels,lk,mapCyl,bd,maniflag,iso,minComplex,tmp,i,
		facets,cylinder,c, maxRounds,infLvl,hom;
	
	if Size(arg) < 2 or Size(arg) > 3 then
		Info(InfoSimpcomp,1,"SCBlowup: number of arguments must be 2 or 3.");
		return fail;
	fi;
	
	pseudomanifold:=arg[1];
	singularity:=arg[2];
	if Size(arg) = 3 then
		mapCyl:=arg[3];
	fi;
	
	if(not SCIsSimplicialComplex(pseudomanifold) or SCDim(pseudomanifold) <> 4 or not SCIsMovableComplex(pseudomanifold)) then
		Info(InfoSimpcomp,1,"SCBlowup: first argument must be a combinatorial pseudomanifold of type SCSimplicialComplex and of dimension 4.");
		return fail;
	fi;
	
	labels:=SCLabels(pseudomanifold);
	if labels = fail then
		return fail;
	fi;
	if(not singularity in labels) then
		Info(InfoSimpcomp,1,"SCBlowup: second argument must be a vertex label of the first argument.");
		return fail;
	fi;
	
	if IsBound(mapCyl) and (not SCIsSimplicialComplex(mapCyl) or SCDim(pseudomanifold) <> 4 or not SCHasBoundary(mapCyl)) then
		Info(InfoSimpcomp,1,"SCBlowup: third argument must be a bounded combinatorial 4-manifold of type SCSimplicialComplex.");
		return fail;
	fi;
	
	lk:=SCLink(pseudomanifold,singularity);
	if lk = fail then
		return fail;
	fi;
	
	Info(InfoSimpcomp,1,"SCBlowup: checking if singularity is a combinatorial manifold...");
	
	maniflag:=SCIsManifold(lk);
	if maniflag = fail then
		return fail;
	fi;
	if not maniflag then
		Info(InfoSimpcomp,1,"SCBlowup: singularity is not a manifold.");
		return fail;
	fi;
	
	Info(InfoSimpcomp,1,"SCBlowup: ...true");
	
	Info(InfoSimpcomp,1,"SCBlowup: checking type of singularity...");
	
	hom:=SCHomology(lk);
	if hom = fail then
		return fail;
	fi;
	
	if not IsBound(mapCyl) then
			
		if hom = [ [ 0, [  ] ], [ 1, [  ] ], [ 0, [ 2 ] ], [ 0, [  ] ] ] then
			mapCyl:=SCFromDifferenceCycles([[1,1,1,1,5]]);
			bd:=SCBoundary(mapCyl);
			if bd = fail then
				return fail;
			fi;
			equivalent:=SCEquivalent(lk,bd);
			if equivalent = fail then
				return fail;
			fi;
			if not equivalent then
				Info(InfoSimpcomp,1,"SCBlowup: type of singularity not supported.");
				return fail;
			fi;
			Info(InfoSimpcomp,1,"SCBlowup: ...3-dimensional Klein bottle (supported type).");	
		elif hom = [ [ 0, [  ] ], [ 1, [  ] ], [ 1, [  ] ], [ 1, [  ] ] ] then
			mapCyl:=SCFromDifferenceCycles([[1,1,1,1,6]]);
			bd:=SCBoundary(mapCyl);
			if bd = fail then
				return fail;
			fi;
			equivalent:=SCEquivalent(lk,bd);
			if equivalent = fail then
				return fail;
			fi;
			if not equivalent then
				Info(InfoSimpcomp,1,"SCBlowup: type of singularity not supported.");
				return fail;
			fi;
			Info(InfoSimpcomp,1,"SCBlowup: ...S^2 x S^1 (supported type).");	
		elif hom = [ [ 0, [ ] ], [ 0, [ 2 ] ], [ 0, [ ] ], [ 1, [ ] ] ] then
			mapCyl:=SC([
			[1,2,3,5,8],[1,2,3,5,11],[1,2,3,8,11],[1,2,4,5,7],[1,2,4,5,11],
			[1,2,4,9,11],[1,2,5,7,8],[1,2,7,8,10],[1,2,8,10,11],[1,3,4,7,8],
			[1,3,5,6,11],[1,3,6,7,11],	[1,3,7,8,11],[1,4,5,7,9],[1,4,5,9,11],
			[1,4,7,8,9],[1,5,7,8,9],[1,6,7,10,11],[1,7,8,10,11],[2,3,5,6,11],
			[2,3,6,9,11],[2,4,5,6,11],[2,4,6,9,11],[3,4,7,8,11],[3,6,7,9,11],
			[4,5,7,9,11],[4,6,8,9,11],[4,7,8,9,11],[6,7,8,9,11],[6,7,8,10,11]]);
			bd:=SCBoundary(mapCyl);
			if bd = fail then
				return fail;
			fi;
			equivalent:=SCEquivalent(lk,bd);
			if equivalent = fail then
				return fail;
			fi;
			if not equivalent then
				Info(InfoSimpcomp,1,"SCBlowup: type of singularity not supported.");
				return fail;
			fi;
			Info(InfoSimpcomp,1,"SCBlowup: ...ordinary double point (supported type).");
		elif hom = [ [ 0, [ ] ], [ 0, [ 3 ] ], [ 0, [ ] ], [ 1, [ ] ] ] then
			mapCyl:=SC([
				[1,2,3,5,7],[1,2,3,5,11],[1,2,3,7,12],[1,2,3,11,12],[1,2,4,5,6],
				[1,2,4,5,11],[1,2,4,6,12],[1,2,4,11,12],[1,2,5,6,7],[1,2,6,7,9],
				[1,2,7,8,9],[1,3,4,6,10],[1,3,4,6,11],[1,3,4,10,12],[1,3,4,11,12],
				[1,3,5,7,10],[1,3,7,10,12],[1,4,5,6,8],[1,4,6,7,8],[1,4,6,7,9],
				[1,4,6,9,11],[1,4,6,10,12],[1,4,7,8,9],[1,5,6,7,8],[1,5,7,10,12],
				[2,3,5,7,10],[2,5,6,7,9],[2,5,7,9,10],[2,7,8,9,10],[3,4,6,7,8],
				[3,4,6,7,11],[3,4,7,8,9],[3,4,7,10,11],[3,4,10,11,12],[3,6,7,8,11],
				[3,7,8,9,12],[3,7,8,10,11],[3,7,8,10,12],[3,8,10,11,12],[4,6,7,9,11],
				[5,7,9,10,12],[7,8,9,10,12]]);
			bd:=SCBoundary(mapCyl);
			if bd = fail then
				return fail;
			fi;
			equivalent:=SCEquivalent(lk,bd);
			if equivalent = fail then
				return fail;
			fi;
			if not equivalent then
				Info(InfoSimpcomp,1,"SCBlowup: type of singularity not supported.");
				return fail;
			fi;
			Info(InfoSimpcomp,1,"SCBlowup: ...L(3,1) (supported type).");
		elif hom = [ [ 0, [ ] ], [ 0, [ 4 ] ], [ 0, [ ] ], [ 1, [ ] ] ] then
			mapCyl:=SC([
				[1,2,4,5,6],[1,2,4,5,12],[1,2,4,6,8],[1,2,4,8,9],[1,2,4,9,12],
				[1,2,5,6,11],[1,2,5,11,12],[1,2,6,8,11],[1,2,7,11,14],[1,2,8,11,14],
				[1,2,9,11,12],[1,3,4,7,9],[1,3,4,7,10],[1,3,4,9,12],[1,3,4,10,12],
				[1,3,5,7,9],[1,3,5,7,12],[1,3,5,9,11],[1,3,5,11,12],[1,3,7,10,12],
				[1,3,9,11,12],[1,4,5,12,13],[1,4,6,8,11],[1,4,7,8,9],[1,4,7,8,11],
				[1,4,10,12,13],[1,5,6,9,11],[1,5,7,8,9],[1,5,7,8,13],[1,5,7,12,13],
				[1,7,8,11,14],[1,7,8,13,14],[1,7,12,13,14],[1,8,10,13,14],[1,10,12,13,14],
				[2,5,6,10,14],[2,5,6,11,14],[2,5,10,11,14],[2,6,8,11,14],[2,6,10,13,14],
				[2,7,11,13,14],[2,10,11,13,14],[3,4,9,12,13],[3,4,10,12,13],[3,5,6,9,11],
				[3,5,6,9,14],[3,5,6,11,14],[3,6,9,11,12],[3,6,9,12,13],[3,6,9,13,14],
				[3,6,10,12,13],[5,6,9,10,14],[6,9,10,12,13],[6,9,10,13,14],[7,8,11,13,14],
				[8,10,11,13,14],[9,10,12,13,14]]);
			bd:=SCBoundary(mapCyl);
			if bd = fail then
				return fail;
			fi;
			equivalent:=SCEquivalent(lk,bd);
			if equivalent = fail then
				return fail;
			fi;
			if not equivalent then
				Info(InfoSimpcomp,1,"SCBlowup: type of singularity not supported.");
				return fail;
			fi;
			Info(InfoSimpcomp,1,"SCBlowup: ...L(4,1) (supported type).");
		elif hom{[1,3,4]} = [ [ 0, [  ] ], [ 0, [  ] ], [ 1, [  ] ] ] and hom[2][1] = 0 and IsBound(hom[2][2]) and Size(hom[2][2]) = 1 and hom[2][2][1] in [5..11] then
			Info(InfoSimpcomp,1,"SCBlowup: Might be singularity of type L(",hom[2][2][1],",1), try loading the complex with the name \"Mapping cylinder L(",hom[2][2][1],",1)\" from the library.");			
		elif hom = [ [ 0, [  ] ], [ 0, [  ] ], [ 0, [  ] ], [ 1, [  ] ] ] then
			equivalent:=SCEquivalent(lk,SCBdSimplex(4));
			if equivalent = fail then
				return fail;
			fi;
			if equivalent then
				Info(InfoSimpcomp,1,"SCBlowup: singularity is a regular vertex, use SCConnectedSum(pseudomanifold,CP^2) or SCConnectedSumMinus(pseudomanifold,CP^2) to perform blowups of ordinary points. Returning SCConnectedSum(pseudomanifold,CP^2).");
				mapCyl:=SC([
					[1,2,3,4,5],[1,2,3,4,7],[1,2,3,5,8],[1,2,3,7,8],[1,2,4,5,6],
					[1,2,4,6,7],[1,2,5,6,8],[1,2,6,7,9],[1,2,6,8,9],[1,2,7,8,9],
					[1,3,4,5,9],[1,3,4,7,8],[1,3,4,8,9],[1,3,5,6,8],[1,3,5,6,9],
					[1,3,6,8,9],[1,4,5,6,7],[1,4,5,7,9],[1,4,7,8,9],[1,5,6,7,9],
					[2,3,4,5,9],[2,3,4,6,7],[2,3,4,6,9],[2,3,5,7,8],[2,3,5,7,9],
					[2,3,6,7,9],[2,4,5,6,8],[2,4,5,8,9],[2,4,6,8,9],[2,5,7,8,9],
					[3,4,6,7,8],[3,4,6,8,9],[3,5,6,7,8],[3,5,6,7,9],[4,5,6,7,8],
					[4,5,7,8,9]]);
				return SCConnectedSum(pseudomanifold,mapCyl);
			fi;
			Info(InfoSimpcomp,1,"SCBlowup: type of singularity not supported.");
			return fail;
		fi;
		
	else
		
		bd:=SCBoundary(mapCyl);
		if bd = fail then
			return fail;
		fi;
		
		equivalent:=SCEquivalent(lk,bd);
		if equivalent = fail then
			return fail;
		fi;
		if not equivalent then
			Info(InfoSimpcomp,1,"SCBlowup: mapping cylinder does not map link of singularity.");
			return fail;
		fi;
		Info(InfoSimpcomp,1,"SCBlowup: ...specified mapping cylinder PL-homeomorphic to link of singularity.");
		
	fi;
	
	Info(InfoSimpcomp,1,"SCBlowup: starting blowup...");
	
	Info(InfoSimpcomp,1,"SCBlowup: map boundaries...");
	
	tmp:=SCIntFunc.MapBoundaries(lk,bd,pseudomanifold,singularity);
	if tmp = fail then
		return fail;
	fi;
	
	Info(InfoSimpcomp,1,"SCBlowup: ...boundaries mapped succesfully.");
	
	Info(InfoSimpcomp,1,"SCBlowup: build complex...");
	
	iso:=tmp[1];
	minComplex:=tmp[2];
	if iso = fail or minComplex = fail then
		return fail;
	fi;

	labels:=[];
	for i in iso do
		labels[i[1]]:=[i[2]];
	od;
	SCRelabel(mapCyl,labels);
	facets:=ShallowCopy(SCFacets(mapCyl));
	if facets = fail then
		return fail;
	fi;
	facets:=List(facets,x->ShallowCopy(x));
	for i in facets do Sort(i); od;
	Sort(facets);
	mapCyl:=SC(facets);
	
	facets:=SCFacets(SCLink(minComplex,singularity));
	if facets = fail then
		return fail;
	fi;
	
	cylinder:=[];
	for i in [1..Size(facets)] do
		Add(cylinder,[facets[i][1],facets[i][2],facets[i][3],facets[i][4],[facets[i][1]]]);
		Add(cylinder,[facets[i][2],facets[i][3],facets[i][4],[facets[i][1]],[facets[i][2]]]);
		Add(cylinder,[facets[i][3],facets[i][4],[facets[i][1]],[facets[i][2]],[facets[i][3]]]);
		Add(cylinder,[facets[i][4],[facets[i][1]],[facets[i][2]],[facets[i][3]],[facets[i][4]]]);
	od;
	cylinder:=SC(cylinder);
	
	c:=Union(Union(Difference(minComplex,SCStar(minComplex,singularity)),cylinder),mapCyl);
	
	Info(InfoSimpcomp,1,"SCBlowup: ...done.");
	
	Info(InfoSimpcomp,1,"SCBlowup: ...blowup completed.");
	Info(InfoSimpcomp,1,"SCBlowup: You may now want to reduce the complex via 'SCReduceComplex'.");
	return c;
	
end);


################################################################################
##<#GAPDoc Label="SCMappingCylinder">
## <ManSection>
## <Func Name="SCMappingCylinder" Arg="k"/>
## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
## <Description>
## Generates a bounded version of <M>\mathbb{C}P^2</M> (a so-called mapping cylinder for a simplicial blowup, compare <Cite Key="Spreer09CombPorpsOfK3"/>) with boundary <M>L(</M><C>k</C><M>,1)</M>.
## <Example>
## gap> mapCyl:=SCMappingCylinder(3);;
## gap> mapCyl.Homology;              
## [ [ 0, [  ] ], [ 0, [  ] ], [ 1, [  ] ], [ 0, [  ] ], [ 0, [  ] ] ]
## gap> l31:=SCBoundary(mapCyl);;
## gap> l31.Homology;
## [ [ 0, [  ] ], [ 0, [ 3 ] ], [ 0, [  ] ], [ 1, [  ] ] ]
## </Example>
## </Description>
## </ManSection>
##<#/GAPDoc>
################################################################################
InstallGlobalFunction(SCMappingCylinder,
function(k)

	local gridtorus,CSsphere,identification,createlens,
		lens,facets,vertices,i,j,complex,
		cyl,simpcyl,idcyl,rencyl,redcyl;

		gridtorus:=function(k)
			local i,j,a,b,complex;
			complex:=[];
			for i in [1..3*k] do
				for j in [1..3*k] do
					if i = 3*k then
						a:=1;
					else
						a:=i+1;
					fi;
					if j = 3*k then
						b:=1;
					else
						b:=j+1;
					fi;
					Add(complex,[[i,j],[a,j],[a,b]]);
					Add(complex,[[i,j],[i,b],[a,b]]);
				od;
			od;
			return complex;
		end;;

		CSsphere:=function(k)
			local sphere, torus, element, a, b, i;
			sphere:=[];
			torus:=gridtorus(k);
			for element in torus do
				a:=Minimum([element[1][1],element[2][1],element[3][1]]);
				if 3*k in [element[1][1],element[2][1],element[3][1]] and a = 1 then
					Add(sphere,Union(element,[[3*k,0]]));
				else
					Add(sphere,Union(element,[[a,0]]));
				fi;
				if element[1][1] = element[2][1] then
					if element[1][1] = 1 then
						Add(sphere,[[3*k,0],[1,0],element[1],element[2]]);
					else
						Add(sphere,[[element[1][1]-1,0],[element[1][1],0],element[1],element[2]]);
					fi;
				fi;
				b:=Minimum([element[1][2],element[2][2],element[3][2]]);
				if 3*k in [element[1][2],element[2][2],element[3][2]] and b = 1 then
					Add(sphere,Union(element,[[0,3*k]]));
				else
					Add(sphere,Union(element,[[0,b]]));
				fi;
				if element[1][2] = element[2][2] then
					if element[1][2] = 1 then
						Add(sphere,[[0,3*k],[0,1],element[1],element[2]]);
					else
						Add(sphere,[[0,element[1][2]-1],[0,element[1][2]],element[1],element[2]]);
					fi;
				fi;
			od;
			for i in [1..Size(sphere)] do
				Sort(sphere[i]);
			od;
			Sort(sphere);
			return sphere;
		end;;


		identification:=function(sphereOrig)
			local i,j,l,max,sphere;
			sphere:=SCIntFunc.DeepCopy(sphereOrig);
			max:=0;
			for i in sphere do
				for j in i do
					for l in j do
						if l > max then
							max:=l;
						fi;
					od;
				od;
			od;
			for i in [1..Size(sphere)] do
				for j in [1..Size(sphere[i])] do
					if sphere[i][j][1] = 0 then				
						sphere[i][j][2]:=((sphere[i][j][2]-1) mod 3)+1;
					elif sphere[i][j][2] = 0 then
						sphere[i][j][1]:=((sphere[i][j][1]-1) mod 3)+1;
					else
						sphere[i][j]:=sphere[i][j]-1;
						while sphere[i][j][1] >= 3 do
							sphere[i][j]:=sphere[i][j]-3;
						od;
						sphere[i][j]:=(sphere[i][j] mod max) +1;
					fi;
				od;
				Sort(sphere[i]);
			od;
			Sort(sphere);
			return Set(sphere);
		end;;


		createlens:=function(k)
			return SC(identification(CSsphere(k)));
		end;;

	lens:=createlens(k);;
	facets:=lens.Facets;;
	cyl:=[]; 
	for i in [1..Size(facets)] do 
		Add(cyl,Union(facets[i],facets[i]+3*k+1)); 
	od;

	simpcyl:=[]; 
	for i in [1..Size(cyl)] do
		simpcyl:=Union(simpcyl,[cyl[i]{[1..5]},cyl[i]{[2..6]},cyl[i]{[3..7]},cyl[i]{[4..8]}]);
	od;
	idcyl:=[]; 
	for i in [1..Size(simpcyl)] do 
		idcyl[i]:=[]; 
		for j in [1..5] do 
			if Maximum(simpcyl[i][j]) <= 3*k then 
				if simpcyl[i][j][1] = 0 then 
					idcyl[i][j] := 3*k+1; 
				elif simpcyl[i][j][2] = 0 then 
					idcyl[i][j]:=3*k+2; 
				else 
					idcyl[i][j]:= (simpcyl[i][j][1]-simpcyl[i][j][2]) mod (3*k);
				fi; 
			else 
				idcyl[i][j]:=ShallowCopy(simpcyl[i][j]); 
			fi; 
		od; 
	od;
	vertices:=Union(idcyl);
	rencyl:=[]; 
	for i in [1..Size(idcyl)] do 
		rencyl[i]:=[]; 
		for j in [1..5] do 
			rencyl[i][j]:=Position(vertices,idcyl[i][j]); 
		od; 
	od;

	redcyl:=[]; 
	for i in rencyl do 
		if Size(Set(i)) = 5 then 
			AddSet(redcyl,i); 
		fi; 
	od;
	complex:=SCFromFacets(redcyl);
	
	SCRename(complex,Concatenation("Mapping cylinder Bd(CP^2) = L(",String(k),",1)"));	
	return complex;

end);

