################################################################################
##
##  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 moves...
## #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);

