GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
#(C) 2009 Graham Ellis ##################################################################### ##################################################################### InstallGlobalFunction(ArrayToPureCubicalComplex, function(AA,threshold) # Inputs an array of integers where 0 represents black # and 753 represents white. It returns a pure cubical complex # where all integers below the threshold are converted to 1, and # higher integers are converted to 0, in the binary list f the cubical # complex. local int2binary,A; ############################## int2binary:=function(A) local i; if ArrayDimension(A)=1 then for i in [1..Length(A)] do if A[i] <threshold then A[i]:=1; else A[i]:=0;fi; od;return A; fi; return List(A,x->int2binary(StructuralCopy(x))); end; ############################## A:=int2binary(AA); return Objectify(HapPureCubicalComplex, rec( binaryArray:=A, properties:=[ ["dimension",ArrayDimension(A)], ["arraySize",ArrayDimensions(A)]] )); end); ##################################################################### ##################################################################### ##################################################################### ##################################################################### InstallGlobalFunction(PureCubicalComplex, function(AA) # Inputs a binary array and returns a pure cubical complex. local A; A:=StructuralCopy(AA); return Objectify(HapPureCubicalComplex, rec( binaryArray:=A, properties:=[ ["dimension",ArrayDimension(A)], ["arraySize",ArrayDimensions(A)]] )); end); ##################################################################### ##################################################################### ##################################################################### ##################################################################### InstallOtherMethod(Dimension, "Dimension of pure cubical complex", [IsHapPureCubicalComplex], function(f) return EvaluateProperty(f,"dimension"); end); ##################################################################### ##################################################################### ##################################################################### ##################################################################### InstallOtherMethod(Dimension, "Dimension of pure cubical complex", [IsHapCubicalComplex], function(f) return EvaluateProperty(f,"dimension"); end); ##################################################################### ##################################################################### ##################################################################### ##################################################################### InstallOtherMethod(Size, "Volume of a pure cubical complex", [IsHapPureCubicalComplex], function(f) return Sum(Flat(f!.binaryArray)); end); ##################################################################### ##################################################################### ##################################################################### ##################################################################### InstallOtherMethod(Size, "Volume of a pure cubical complex", [IsHapCubicalComplex], function(f) return Sum(Flat(f!.binaryArray)); end); ##################################################################### ##################################################################### ##################################################################### ##################################################################### InstallMethod(EulerCharacteristic, "Euler characteristic of a pure cubical complex", [IsHapPureCubicalComplex], function(M) local D; D:=ChainComplexOfCubicalComplex( PureCubicalComplexToCubicalComplex(M),true); return Sum(List([0..Dimension(M)],i->((-1)^i)*D!.dimension(i))); end); ##################################################################### ##################################################################### ##################################################################### ##################################################################### InstallOtherMethod(EulerCharacteristic, "Euler characteristic of a cubical complex", [IsHapCubicalComplex], function(M) local C; C:=ChainComplexOfCubicalComplex(M,true); return Sum(List([0..Dimension(M)],i->((-1)^i)*C!.dimension(i))); end); ##################################################################### ##################################################################### ##################################################################### ##################################################################### InstallOtherMethod(EulerCharacteristic, "Euler characteristic of a chain complex", [IsHapChainComplex], function(C); return Sum(List([0..Length(C)],i->((-1)^i)*C!.dimension(i))); end); ##################################################################### ##################################################################### ##################################################################### ##################################################################### InstallOtherMethod(Length, "Length of a chain complex", [IsHapChainComplex], function(C); return EvaluateProperty(C,"length"); end); ##################################################################### ##################################################################### ##################################################################### ##################################################################### InstallOtherMethod(Length, "Length of a sparse chain complex", [IsHapSparseChainComplex], function(C); return EvaluateProperty(C,"length"); end); ##################################################################### ##################################################################### ##################################################################### ##################################################################### InstallOtherMethod(EulerCharacteristic, "Euler characteristic of a sparse chain complex", [IsHapSparseChainComplex], function(C); return Sum(List([0..Length(C)],i->((-1)^i)*C!.dimension(i))); end); ##################################################################### ##################################################################### ################################################################# ################################################################# InstallGlobalFunction(ReadMatrixAsPureCubicalComplex, function(AA) local PCC,B, fn, Dims,x, Dim, i, Iter,A; A:=SSortedList(AA); Dims:=[]; Dim:=Length(A[1]); for i in [1..Dim] do Add(Dims,3+Maximum(List(A,x->x[i]))); od; B:=List([1..1+Dims[Length(Dims)]],a->0); for i in Reversed([1..Dim-1]) do B:=List([1..Dims[i]],a->StructuralCopy(B)); od; ############## if Dim=1 then for x in A do B[1+x[1]]:=1; od; fi; ############## if Dim=2 then for x in A do B[1+x[1]][1+x[2]]:=1; od; fi; ############## if Dim=3 then for x in A do B[1+x[1]][1+x[2]][1+x[3]]:=1; od; fi; ############## if Dim=4 then for x in A do B[1+x[1]][1+x[2]][1+x[3]][1+x[4]]:=1; od; fi; ############## if Dim=5 then for x in A do B[1+x[1]][1+x[2]][1+x[3]][1+x[4]][1+x[5]]:=1; od; fi; ############## if Dim=6 then for x in A do B[1+x[1]][1+x[2]][1+x[3]][1+x[4]][1+x[5]][1+x[6]]:=1; od; fi; ############## if Dim=7 then for x in A do B[1+x[1]][1+x[2]][1+x[3]][1+x[4]][1+x[5]][1+x[6]][1+x[7]]:=1; od; fi; ############## if Dim=8 then for x in A do B[1+x[1]][1+x[2]][1+x[3]][1+x[4]][1+x[5]][1+x[6]][1+x[7]][1+x[8]]:=1; od; fi; ############## if Dim>8 then Print("This function is not yet implemented for matrices with more than 8 columns.\n"); return fail; fi; return PureCubicalComplex(B);; end); ##################################################################### ##################################################################### HAPAAA:=0; ################################################################# ################################################################# InstallGlobalFunction(ReadImageAsPureCubicalComplex, function(file,threshold) # Inputs a string "file" that points either to a single image file, or # to a list of suitable image files, and returns either a 2-dimensional # or 3-dimensional cubical complex. local f,i,x,prog,B,A,AA,pth; pth:=HAP_ROOT; prog:=Concatenation(pth,"PolyComplexes/prog"); ################################## if IsString(file) then i:=Concatenation("convert -colorspace RGB -depth 8 ",file," /tmp/im.txt"); Exec(i); i:=Concatenation("perl ",prog," /tmp/im.txt >/tmp/im.g"); Exec(i); Read("/tmp/im.g"); Exec("rm /tmp/im.g"); Exec("rm /tmp/im.txt"); B:=StructuralCopy(HAPAAA); HAPAAA:=0; A:=[]; for i in [1..B[1]] do A[i]:=List([1..B[2]],a->0); od; for x in B{[3..Length(B)-1]} do A[x[1]][x[2]]:=x[3]; od; if not IsInt(threshold) then return A; fi; return ArrayToPureCubicalComplex(A,threshold); fi; ################################# ################################## if IsList(file) then AA:=[]; for f in file do i:=Concatenation("convert ",f," /tmp/im.txt"); Exec(i); i:=Concatenation("perl ",prog," /tmp/im.txt >/tmp/im.g"); Exec(i); Read("/tmp/im.g"); Exec("rm /tmp/im.g"); Exec("rm /tmp/im.txt"); B:=StructuralCopy(HAPAAA); A:=[]; for i in [1..B[1]] do A[i]:=List([1..B[2]],a->0); od; for x in B{[3..Length(B)-1]} do A[x[1]][x[2]]:=x[3]; od; Add(AA,StructuralCopy(A)); HAPAAA:=0; od; return ArrayToPureCubicalComplex(AA,threshold); fi; ################################# end); ################################################################# ################################################################# ################################################################# ################################################################# InstallGlobalFunction(ReadImageSequenceAsPureCubicalComplex, function(directory,threshold) local L,file,linecommand,instr,f; file:="/tmp/imagesfile.txt"; L:=[]; linecommand:=Concatenation("ls ",directory," > ",file); Exec(linecommand); instr:=InputTextFile(file); f:=ReadLine(instr); while not f=fail do Add(L,Concatenation(directory,"/",f{[1..Length(f)-1]})); f:=ReadLine(instr); od; return ReadImageAsPureCubicalComplex(L,threshold); end); ################################################################# ################################################################# ################################################################# ################################################################# InstallGlobalFunction(PureCubicalComplexToCubicalComplex, function(M) # Converts a pure cubical complex to a cubical complex local A,x,i,dim,dim1,dims,ball,b,dimsM,ArrayValueDim, ArrayValueDim1, ArrayAssignDim,ArrayIt,dimsSet,Fun; if IsHapFilteredPureCubicalComplex(M) then return FilteredPureCubicalComplexToCubicalComplex(M); fi; dim:=Dimension(M); dim1:=dim-1; ArrayValueDim:=ArrayValueFunctions(dim); ArrayValueDim1:=ArrayValueFunctions(dim-1); ArrayAssignDim:=ArrayAssignFunctions(dim); ArrayIt:=ArrayIterate(dim); dimsM:=EvaluateProperty(M,"arraySize"); dims:=List(EvaluateProperty(M,"arraySize"),n->2*n+1); A:=List([1..dims[1]],a->0); for i in [2..Dimension(M)] do A:=List([1..dims[i]],a->StructuralCopy(A)); od; ball:=Cartesian(List([1..dim],i->[-1,0,1])); dimsSet:=List([1..dim],x->[1..dimsM[x]]); ######################### Fun:=function(i); if ArrayValueDim(M!.binaryArray,i)=1 then for b in ball do x:=2*i+b; ArrayAssignDim(A,x,1); od; fi; end; ######################### ArrayIt(dimsSet,Fun); return Objectify(HapCubicalComplex, rec( binaryArray:=A, properties:=[ ["dimension",dim], ["arraySize",dims]] )); end); ################################################################# ################################################################# ################################################################# ################################################################# InstallGlobalFunction(ChainComplexOfCubicalComplex, function(arg) local M,faces,dims,dim,dim1,x,y,z,numevens,Dimsn,Boundary,BinLst,LstBin, ArrayValueDim,ArrayValueDim1,ArrayAssignDim,ArrayIt,dimsSet,Fun,LF; # Inputs a cubical complex and returns the associated cellular # chain complex. M:=arg[1]; if not IsHapCubicalComplex(M) then Print("This function must be applied to a cubical complex.\n"); return fail; fi; faces:=List([0..Dimension(M)+10],i->0); dims:=EvaluateProperty(M,"arraySize"); dimsSet:=List(dims,d->[1..d]); dim:=Dimension(M); dim1:=dim-1; ArrayValueDim:=ArrayValueFunctions(dim); ArrayValueDim1:=ArrayValueFunctions(dim1); ArrayAssignDim:=ArrayAssignFunctions(dim); ArrayIt:=ArrayIterate(dim); BinLst:=M!.binaryArray*0; #BinLst will be an array where the value #of an entry is the position of the cell #corresponding to that entry in the list #of all cells of similar dimension. LstBin:=List([0..Dimension(M)],i->[]); #LstBin is a list of lists. The i-th entry of the #j-th list is the coordinates in M!.binaryArray #of the i-th cell in dimension j-1. ############################## numevens:=function(x); return Length(Filtered(x,i->IsEvenInt(i))); end; ############################## if Length(arg)=1 then ####################### Fun:=function(x) local y,z; if ArrayValueDim(M!.binaryArray,x)=1 then y:=numevens(x)+1; faces[y]:=faces[y]+1; ArrayAssignDim(BinLst,x,faces[y]); LstBin[y][faces[y]]:=x; fi; end; ####################### ArrayIt(dimsSet,Fun); else ####################### Fun:=function(x) local y; if ArrayValueDim(M!.binaryArray,x)=1 then y:=numevens(x)+1; faces[y]:=faces[y]+1; fi; end; ####################### ArrayIt(dimsSet,Fun); fi; ####################################### Dimsn:=function(n); return faces[n+1]; end; ####################################### LF:=[]; for x in [1..Length(faces)] do LF[x]:=0*[1..faces[x]]; od; if EvaluateProperty(M,"nonregular")=true then ####################################### Boundary:=function(n,j) #THIS ONLY WORKS CORRECTLY MOD 2 AT PRESENT local x,poscells,negcells,nn,a,b,cnt; poscells:=[]; negcells:=[]; cnt:=0; nn:=Reversed(LstBin[n+1][j]); for x in [1..Length(nn)] do if IsEvenInt(nn[x]) then cnt:=cnt+1; a:=StructuralCopy(nn); a[x]:=a[x]+1; b:=StructuralCopy(nn); b[x]:=b[x]-1; if IsOddInt(cnt) then Append(poscells,M!.rewrite([a])); Append(negcells,M!.rewrite([b])); else Append(poscells,M!.rewrite([b])); Append(negcells,M!.rewrite([a])); fi; fi; od; Apply(poscells,x->ArrayValueDim(BinLst,Reversed(x))); Apply(negcells,x->ArrayValueDim(BinLst,Reversed(x))); #nn:=List([1..faces[n]],i->0); nn:=0*LF[n]; for x in poscells do nn[x]:=nn[x]-1; od; for x in negcells do nn[x]:=nn[x]+1; od; return nn; end; ####################################### else ####################################### Boundary:=function(n,j) local x,poscells,negcells,nn,a,b,cnt; poscells:=[]; negcells:=[]; cnt:=0; nn:=LstBin[n+1][j]; for x in [1..Length(nn)] do if IsEvenInt(nn[x]) then cnt:=cnt+1; a:=StructuralCopy(nn); a[x]:=a[x]+1; b:=StructuralCopy(nn); b[x]:=b[x]-1; if IsOddInt(cnt) then Add(poscells,a); Add(negcells,b); else Add(poscells,b); Add(negcells,a); fi; fi; od; Apply(poscells,x->ArrayValueDim(BinLst,x)); Apply(negcells,x->ArrayValueDim(BinLst,x)); nn:=List([1..faces[n]],i->0); #nn:=(LF[n]); Apply(nn,x->0); for x in poscells do nn[x]:=-1; od; for x in negcells do nn[x]:=1; od; return nn; end; ####################################### fi; return Objectify(HapChainComplex, rec( dimension:=Dimsn, boundary:=Boundary, coordinateToPosition:=BinLst, positionToCoordinate:=LstBin, properties:=[ ["length",EvaluateProperty(M,"dimension")], ["type","chainComplex"], ["characteristic",0]] )); end); ################################################################# ################################################################# ##################################################################### ##################################################################### InstallMethod(ChainComplex, "Cellular chain complex of a cubical complex", [IsHapCubicalComplex], function(M) return ChainComplexOfCubicalComplex(M);; end); ##################################################################### ##################################################################### ##################################################################### ##################################################################### InstallMethod(ChainComplexOfPair, "Cellular chain complex of a pair of cubical complexes", [IsHapCubicalComplex,IsHapCubicalComplex], function(M,S) return ChainComplexOfCubicalPair(M,S);; end); ##################################################################### ##################################################################### ##################################################################### ##################################################################### InstallOtherMethod(ChainComplexOfPair, "Cellular chain complex of a pair of pure cubical complexes", [IsHapPureCubicalComplex,IsHapPureCubicalComplex], function(MM,SS) local M,S,P; P:=ExcisedPureCubicalPair(MM,SS); M:=P[1];S:=P[2]; #M:=MM;S:=SS; return ChainComplexOfCubicalPair( PureCubicalComplexToCubicalComplex(M), PureCubicalComplexToCubicalComplex(S));; end); ##################################################################### ##################################################################### ##################################################################### ##################################################################### InstallOtherMethod(ChainComplex, "Cellular chain complex of a pure cubical complex", [IsHapPureCubicalComplex], function(M) return ChainComplexOfCubicalComplex(PureCubicalComplexToCubicalComplex(M));; end); ##################################################################### ##################################################################### ##################################################################### ##################################################################### InstallGlobalFunction(ChainComplexOfCubicalPair, function(M,S) local faces,dim,dim1,dims,index,x,y,z,numevens,Dimsn,Boundary,BinLst,LstBin, ArrayValueDim,ArrayValueDim1,Generator2Coordinates,Coordinates2Generator,NN; # Inputs a pair of cubical complexes and returns the cellular # chain complex of " M/S ". faces:=List([0..Dimension(M)],i->0); dims:=EvaluateProperty(M,"arraySize"); index:=Cartesian(List([1..Dimension(M)],x->[1..dims[x]])); ## ## ##For n=2,3,4 I should write quicker code that does not construct index ## ## ## dim:=Dimension(M); dim1:=dim-1; ArrayValueDim:=ArrayValueFunctions(dim); ArrayValueDim1:=ArrayValueFunctions(dim1); BinLst:=M!.binaryArray*0; #BinLst will be an array where the value #of an entry is the position of the cell #corresponding to that entry in the list #of all cells of similar dimension. LstBin:=List([0..Dimension(M)],i->[]); #LstBin is a list of lists. The i-th entry of the #j-th list is the coordinates in M!.binaryArray #of the i-th cell in dimension j-1. ############################## numevens:=function(x); return Length(Filtered(x,i->IsEvenInt(i))); end; ############################## for x in index do if ArrayValueDim(M!.binaryArray,x)=1 and ArrayValueDim(S!.binaryArray,x)=0 then y:=numevens(x)+1; faces[y]:=faces[y]+1; z:=ArrayValueDim1(BinLst,x{[2..Length(x)]}); z[x[1]]:=faces[y]; LstBin[y][faces[y]]:=x; fi; od; ####################################### Dimsn:=function(n); return faces[n+1]; end; ####################################### NN:=List([1..dim],i-> List([1..faces[i]],a->0)); ####################################### Boundary:=function(n,j) local x,poscells,negcells,nn,a,b,cnt; poscells:=[]; negcells:=[]; cnt:=0; nn:=LstBin[n+1][j]; for x in [1..Length(nn)] do if IsEvenInt(nn[x]) then cnt:=cnt+1; a:=StructuralCopy(nn); a[x]:=a[x]+1; b:=StructuralCopy(nn); b[x]:=b[x]-1; if IsOddInt(cnt) then if ArrayValueDim(S!.binaryArray,a)=0 then Add(poscells,a); fi; if ArrayValueDim(S!.binaryArray,b)=0 then Add(negcells,b); fi; else if ArrayValueDim(S!.binaryArray,b)=0 then Add(poscells,b); fi; if ArrayValueDim(S!.binaryArray,a)=0 then Add(negcells,a); fi; fi; fi; od; Apply(poscells,x->ArrayValueDim(BinLst,x)); Apply(negcells,x->ArrayValueDim(BinLst,x)); #nn:=List([1..faces[n]],i->0); nn:=StructuralCopy(NN[n]); for x in poscells do nn[x]:=-1; od; for x in negcells do nn[x]:=1; od; return nn; end; ####################################### ####################################### Generator2Coordinates:=function(n,j); return LstBin[n+1][j]; end; ####################################### ####################################### Coordinates2Generator:=function(x); return ArrayValueDim(BinLst,x); end; ####################################### return Objectify(HapChainComplex, rec( dimension:=Dimsn, boundary:=Boundary, generator2Coordinates:=Generator2Coordinates, coordinates2Generator:=Coordinates2Generator, properties:=[ ["length",EvaluateProperty(M,"dimension")], ["type","chainComplex"], ["characteristic",0]] )); end); ##################################################################### ##################################################################### ##################################################################### ##################################################################### InstallGlobalFunction(ChainMapOfCubicalPairs, function(arg) #X is a subspace of Y. #S is a contractible subspace of X (and T). #T is a contractible subspace of Y. #We return C(X/S)-->C(Y/T). local X,S,Y,T,C,D,map; ###########INPUT#################### if Length(arg)=4 then X:=arg[1]; S:=arg[2]; Y:=arg[3]; T:=arg[4]; C:=ChainComplexOfPair(X,S); D:=ChainComplexOfPair(Y,T); fi; if Length(arg)=2 then C:=arg[1]; D:=arg[2]; fi; #################################### ############################################### map:=function(v,n) local x,w,i; w:=List([1..D!.dimension(n)],a->0); for i in [1..Length(v)] do if not v[i]=0 then x:=C!.generator2Coordinates(n,i); x:=D!.coordinates2Generator(x); if not x=0 then w[x]:=v[i]; fi; fi; od; return w; end; ############################################### return Objectify(HapChainMap, rec( source:=C, target:=D, mapping:=map, properties:=[ ["type","chainMap"], ["characteristic", 0] ])); end); ##################################################################### ##################################################################### ###################################################################### ###################################################################### InstallGlobalFunction(ContractibleSubcomplexOfPureCubicalComplex, function(T) local A,P,mx,Pmx; if not IsHapPureCubicalComplex(T) then Print("This function can only be applied to pure cubical complexes.\n"); return fail; fi; if Size(T)=0 then return T; fi; P:=PathComponentOfPureCubicalComplex(T,0); P:=List([1..P],x->Size(PathComponentOfPureCubicalComplex(T,x))); mx:=Position(P,Maximum(P)); Pmx:=PathComponentOfPureCubicalComplex(T,mx); A:=ContractibleSubArray(Pmx!.binaryArray); return Objectify(HapPureCubicalComplex, rec( binaryArray:=A, properties:=StructuralCopy(T!.properties) )); end); ###################################################################### ###################################################################### ###################################################################### ###################################################################### InstallGlobalFunction(AcyclicSubcomplexOfPureCubicalComplex, function(T) local A,P,x; if not IsHapPureCubicalComplex(T) then Print("This function can only be applied to pure cubical complexes.\n"); return fail; fi; P:=PathComponentOfPureCubicalComplex(T,0); A:=0*T!.binaryArray; for x in T!.pathReps do ArrayAssign(A,x,1); od; A:=PureCubicalComplex(A);; A:=HomotopyEquivalentMaximalPureCubicalSubcomplex(T,A); return A; end); ###################################################################### ###################################################################### ################################################################# ################################################################# InstallGlobalFunction(WritePureCubicalComplexAsImage, function(T,file,ext) local A,i,j,rows,cols,colour,filetxt; # This writes a 2-dimensional cubical complex to an image file. if not Dimension(T)=2 then Print("There is no method for viewing a pure cubical complex of dimension ", Dimension(T),".\n"); return fail; fi; A:=T!.binaryArray; rows:=Length(A);; cols:=Length(A[1]); filetxt:=Concatenation(file,".txt"); PrintTo(filetxt,"# ImageMagick pixel enumeration: ", Length(A),",",Length(A[1]),",255,RGB\n"); for i in [1..rows] do for j in [1..cols] do if A[i][j]=0 then colour:="(255,255,255)"; else colour:="(0,0,100)";fi; AppendTo(filetxt,i,",",j,": ",colour,"\n"); od; od; i:=Concatenation("convert ",filetxt," ",file,".",ext); Exec(i); i:=Concatenation("rm ",filetxt); Exec(i); end); ################################################################# ################################################################# ################################################################# ################################################################# InstallGlobalFunction(ViewPureCubicalComplex, function(arg) local i,A,viewer,T; # Function for viewing 2-dimensional pure cubical complexes. T:=arg[1]; if not (Dimension(T)=2 or Dimension(T)=3) then Print("There is no method for viewing a pure cubical complex of dimension ", Dimension(T),".\n"); return fail; fi; if Dimension(T)=3 then View3dPureComplex(T); else T!.binaryArray:=FrameArray(T!.binaryArray); T!.binaryArray:=FrameArray(T!.binaryArray); if Length(arg)>1 then viewer:=arg[2]; else viewer:=DISPLAY_PATH;fi; WritePureCubicalComplexAsImage(T,"/tmp/HAPtmpImage","png"); Exec(Concatenation(viewer," ","/tmp/HAPtmpImage.png")); Sleep(2); Exec(Concatenation("rm ","/tmp/HAPtmpImage.png")); fi; end); ################################################################# ################################################################# ################################################################# ################################################################# InstallGlobalFunction(CechComplexOfPureCubicalComplex, function(arg) local M,DIM,Vertices, Simplices, SimplicesLst, NrSimplices, EnumeratedSimplex, S, VertexCoordinates, dim,dim1,dims, CartProd, Ball, Star, EdgeStar, ArrayValueDim, ArrayValueDim1, v, x, y, U, V, i; M:=arg[1]; if Length(arg)>1 then DIM:=1+arg[2]; else DIM:=10000; fi; ##SLOPPY!! if not IsHapPureCubicalComplex(M) then Print("This function can only be applied to a pure cubical complex.\n"); return fail; fi; dim:=Dimension(M); dim1:=dim-1; ArrayValueDim:=ArrayValueFunctions(dim); ArrayValueDim1:=ArrayValueFunctions(dim1); dims:=EvaluateProperty(M,"arraySize"); S:=StructuralCopy(M!.binaryArray); Vertices:=0; VertexCoordinates:=[]; Ball:=Cartesian(List([1..dim],i->[-1,1])); CartProd:=Cartesian(List([1..dim],a->[1..dims[a]])); for x in CartProd do if ArrayValueDim(M!.binaryArray,x)=1 then Vertices:=Vertices+1; y:=ArrayValueDim1(S,x{[2..dim]}); y[x[1]]:=Vertices; VertexCoordinates[Vertices]:=x; fi; od; Vertices:=[1..Vertices]; SimplicesLst:=List([1..1000],i->[]); #VERY SLOPPY!!! SimplicesLst[1]:=List(Vertices,i->[i]); ################################################################# NrSimplices:=function(n); return Length(SimplicesLst[n+1]); end; ################################################################# ################################################################# Simplices:=function(n,i); return SimplicesLst[n+1][i]; end; ################################################################# ################################################################# Star:=function(x) # For an odd array point x in the corresponding cubical complex T # this function returns the list of all integers in Vertices # corresponding to those pure cells in T that touch the vertex # T!.binaryArray[x]. local y,z,verts; verts:=[]; for y in Ball do z:=(x+y)/2; #z is even if (not 0 in z) and (not -1 in dims - z) then if ArrayValueDim(M!.binaryArray,z)=1 then Add(verts, ArrayValueDim(S,z)); fi; fi; od; return verts; end; ################################################################# for v in Cartesian(List([1..dim],a->List([0..dims[a]],j->2*j+1))) do U:=Star(v); for i in [2..Minimum(DIM,Length(U))] do V:=Combinations(U,i); for y in V do Add(SimplicesLst[i],y); od; od; od; for i in [1..Length(SimplicesLst)] do SimplicesLst[i]:=SSortedList(SimplicesLst[i]); od; ############################################# EnumeratedSimplex:=function(v); return Position(SimplicesLst[Length(v)],v); end; ############################################# return Objectify(HapSimplicialComplex, rec( vertices:=Vertices, simplices:=Simplices, simplicesLst:=SimplicesLst, nrSimplices:=NrSimplices, enumeratedSimplex:=EnumeratedSimplex, properties:=[ ["dimension",PositionProperty(SimplicesLst,IsEmpty)-2] ] )); end); ################################################################# ################################################################# ################################################################# ################################################################# InstallGlobalFunction(HomologyOfPureCubicalComplex, function(arg) local M,S,T,C,H,dim,b,P,i,n,p; #Only use this function on path-connected spaces M:=arg[1]; ###################### if Length(arg)>1 then if arg[2]=0 then return [1..PathComponentOfPureCubicalComplex(M,0)]*0; fi; fi; ###################### dim:=Dimension(M); T:=rec(); T.binaryArray:=StructuralCopy(M!.binaryArray); T.properties:=StructuralCopy(M!.properties); T:=Objectify(HapPureCubicalComplex,T); #T:=ZigZagContractedPureCubicalComplex(T); #T:=CropPureCubicalComplex(T); #S:=ContractibleSubcomplexOfPureCubicalComplex(T); S:=AcyclicSubcomplexOfPureCubicalComplex(T); C:=ChainComplexOfPair(T,S); ##################### if Length(arg)=1 then H:=[]; H[1]:=List([1..PathComponentOfPureCubicalComplex(T,0)],a->0); for i in [1..dim-1] do H[i+1]:=Homology(C,i); od; H[dim+1]:=[]; return H; fi; ##################### ##################### if Length(arg)=2 then n:=arg[2]; return Homology(C,n); fi; ##################### ##################### if Length(arg)=3 then n:=arg[2]; p:=arg[3]; return Homology(TensorWithIntegersModP(C,p),n); fi; ##################### end); ################################################################# ################################################################# ################################################################# ################################################################# InstallOtherMethod(Homology, "Homology of a pure cubical complex", [IsHapPureCubicalComplex], function(MM) local M,i,k,b,P,H,tmp,dim; M:=ZigZagContractedPureCubicalComplex(MM); M:=CropPureCubicalComplex(M); ############################ if Dimension(M)=2 then H:=List(BettinumbersOfPureCubicalComplex_dim_2(M),b->[1..b]*0); return H; fi; ############################ dim:=Dimension(M); H:=List([0..dim],x->[]); b:=PathComponentOfPureCubicalComplex(M,0); if b=0 then return H; fi; for i in [1..b] do P:=PathComponentOfPureCubicalComplex(M,i); tmp:=HomologyOfPureCubicalComplex(P); for k in [0..dim] do Append(H[k+1],tmp[k+1]); od; od; return H; end); ################################################################# ################################################################# ################################################################# ################################################################# InstallOtherMethod(Bettinumbers, "Ranks of homologies of a pure cubical complex", [IsHapPureCubicalComplex], function(M) local H,T; ############################ if Dimension(M)=2 then return BettinumbersOfPureCubicalComplex_dim_2(M); fi; ############################ H:=Homology(M); H:=List(H,x->Length(Filtered(x,a->a=0))); return H; end); ################################################################# ################################################################# ################################################################# ################################################################# InstallOtherMethod(Bettinumbers, "Rank of n-th homology of a pure cubical complex", [IsHapPureCubicalComplex,IsInt], function(M,n) local H; if n=0 then return PathComponentOfPureCubicalComplex(M,0); fi; if Dimension(M)=2 then return Bettinumbers(M)[n+1]; fi; H:=Homology(M,n); H:=Length(Filtered(H,a->a=0)); return H; end); ################################################################# ################################################################# ################################################################# ################################################################# InstallOtherMethod(Bettinumbers, "Rank of n-th homology of a chain complex", [IsHapChainComplex,IsInt], function(M,n) local H, p; if EvaluateProperty(M,"characteristic")<=0 then return Homology(TensorWithRationals(M),n); fi; p:=EvaluateProperty(M,"characteristic"); return Homology(TensorWithIntegersModP(M,p),n); end); ################################################################# ################################################################# ################################################################# ################################################################# InstallOtherMethod(Homology, "Homology of a pure cubical complex", [IsHapPureCubicalComplex,IsInt,IsInt], function(MM,n,p) local M,i,k,b,P,H,tmp,dim; ############################ if Dimension(MM)=2 then if p=0 then return [1..BettinumbersOfPureCubicalComplex_dim_2(MM)[n+1]]*0; fi; return BettinumbersOfPureCubicalComplex_dim_2(MM)[n+1]; fi; ############################ M:=ZigZagContractedPureCubicalComplex(MM); M:=CropPureCubicalComplex(M); dim:=Dimension(M); b:=PathComponentOfPureCubicalComplex(M,0); if b=0 then return []; fi; if p=0 then H:=[]; for i in [1..b] do P:=PathComponentOfPureCubicalComplex(M,i); tmp:=HomologyOfPureCubicalComplex(P,n,p); Append(H,tmp); od; return H; fi; H:=0; for i in [1..b] do P:=PathComponentOfPureCubicalComplex(M,i); tmp:=HomologyOfPureCubicalComplex(P,n,p); H:=H+tmp; od; return H; end); ################################################################# ################################################################# ################################################################# ################################################################# InstallOtherMethod(Homology, "Homology of a pure cubical complex", [IsHapPureCubicalComplex,IsInt], function(M,n) return Homology(M,n,0); end); ################################################################# ################################################################# ################################################################# ################################################################ InstallGlobalFunction(SingularitiesOfPureCubicalComplex, function(MM,radius,tolerance) local M,B, CART, dim,dim1,dims, IsSingular, Circle, Ball, dimsBall, ArrayValueDim, ArrayValueDim1, x,z; ############################################# if not IsHapPureCubicalComplex(MM) then Print("This function must be applied to a pure cubical complex.\n"); return fail; fi; ############################################# M:=BoundaryOfPureCubicalComplex(MM); #M:=ContractPureCubicalComplex(M); B:=M!.binaryArray*0; dim:=Dimension(M); dim1:=dim-1; ArrayValueDim:=ArrayValueFunctions(dim); ArrayValueDim1:=ArrayValueFunctions(dim1); dims:=EvaluateProperty(M,"arraySize"); CART:=Cartesian(List([1..dim],a->[1..dims[a]])); Circle:=Cartesian(List([1..dim],i->[-radius..radius])); Ball:=Cartesian(List([1..dim],i->[-radius+1..radius-1])); Circle:=Filtered(Circle,x->not x in Ball); Ball:=[1..2*radius+1]; for x in [2..dim] do Ball:=List(Ball,x->StructuralCopy(Ball)); od; Ball:=Ball*0; for x in Circle do z:=ArrayValueDim1(Ball,x{[2..Length(x)]}+radius+1); z[x[1]+radius+1]:=1; od; Ball:=rec( binaryArray:=Ball, properties:=[ ["dimension",dim], ["arraySize", List([1..dim],a->2*radius+1)]]); Ball:=Objectify(HapPureCubicalComplex,Ball); dimsBall:=EvaluateProperty(Ball,"arraySize"); ######################## IsSingular:=function(x) local w,y,yy,z,B,ball,L,w1,y1; if ArrayValueDim(M!.binaryArray,x)=0 then return false;fi; B:=StructuralCopy(Ball!.binaryArray); ball:=ArrayToPureCubicalComplex(B,1); ball!.binaryArray:=B; for y in Circle do z:=x+y;yy:=y+radius+1; if (not Minimum(z)<1) and (not Minimum(dims - z)<0) then if ArrayValueDim(M!.binaryArray,z)=1 then w:=ArrayValueDim1(ball!.binaryArray,yy{[2..Length(yy)]}); w[yy[1]]:=0; fi; fi; od; yy:=PathComponentOfPureCubicalComplex(ball,0); L:=List([1..yy],a->PathComponentOfPureCubicalComplex(ball,a)); L:=List(L,a->Flat(a!.binaryArray)); L:=List(L, a->Filtered(a,i->i=1)); L:=List(L,a->Length(a)); w:=Maximum(L); w1:=Position(L,w); L[w1]:=0; y:=Maximum(L); if 100*AbsInt(y-w)/Length(Circle)>tolerance then return true; else return false; fi; end; ######################## for x in CART do if IsSingular(x) then z:=ArrayValueDim1(B,x{[2..dim]}); z[x[1]]:=1; fi; od; return Objectify(HapPureCubicalComplex, rec( binaryArray:=B, properties:=[ ["dimension",Dimension(M)], ["arraySize",dims]] )); end); ################################################################# ################################################################# ################################################################# ################################################################# InstallGlobalFunction(ChainInclusionOfPureCubicalPair, function(M,N) local map,C,D,k,U; C:=ChainComplex(M); D:=ChainComplex(N); U:=[]; for k in [0..EvaluateProperty(D,"length")] do U[k+1]:=List([1..D!.dimension(k)],i->0); od; ########################### map:=function(v,k) local u,i; u:=U[k+1]*0; for i in [1..C!.dimension(k)] do if not v[i]=0 then u[ ArrayValue(D!.coordinateToPosition,C!.positionToCoordinate[k+1][i]) ]:=v[i]; fi; od; return u; end; ########################### return Objectify(HapChainMap, rec( source:=C, target:=D, mapping:=map, properties:=[ ["type","chainMap"], ["characteristic", 0], ])); end); ################################################################# ################################################################# ################################################################# ################################################################# InstallGlobalFunction(DirectProductOfPureCubicalComplexes, function(M,N) local D, dimM,dimN,dim, dimsM,dimsN,dims, CART, ArrayValueDimM, ArrayValueDimN, ArrayValueDim1, x,w; dimM:=Dimension(M); dimN:=Dimension(N); dim:=dimM+dimN; ArrayValueDimM:=ArrayValueFunctions(dimM); ArrayValueDimN:=ArrayValueFunctions(dimN); ArrayValueDim1:=ArrayValueFunctions(dim-1); dimsM:=EvaluateProperty(M,"arraySize"); dimsN:=EvaluateProperty(N,"arraySize"); dims:=Concatenation(dimsM,dimsN); CART:=Cartesian(List([1..dim],i->[1..dims[i]])); D:=[1..dims[1]]*0; for x in [2..dim] do D:=List([1..dims[x]],i->StructuralCopy(D)); od; for x in CART do if ArrayValueDimM(M!.binaryArray,x{[1..dimM]})=1 and ArrayValueDimN(N!.binaryArray,x{[dimM+1..dimM+dimN]})=1 then w:=ArrayValueDim1(D,x{[2..dim]}); w[x[1]]:=1; fi; od; D:=PureCubicalComplex(D); return D; end); ################################################################# ################################################################# ################################################################# ################################################################# InstallGlobalFunction(PureCubicalComplexToTextFile, function(file,M) local dim,dims,CART,x,i; dim:=Dimension(M); dims:=EvaluateProperty(M,"arraySize"); CART:=Cartesian(List(dims,d->[1..d])); for x in CART do if ArrayValue(M!.binaryArray,x)=1 then for i in [1..dim] do AppendTo(file,String(x[i])," "); od; AppendTo(file,"\n"); fi; od; end); ################################################################# ################################################################# ################################################################# ################################################################# InstallGlobalFunction(ExcisedPureCubicalPair, function(M,S) local B,intS,N, M1, S1; if Dimension(M)=2 then return ExcisedPureCubicalPair_dim_2(M,S); fi; #B:=BoundaryOfPureCubicalComplex(S); #intS:=PureCubicalComplexDifference(S,B); #N:=PureCubicalComplexDifference(M,intS); B:=PureComplexDifference(M,S); B:=ThickenedPureComplex(B); B:=PureCubicalComplexDifference(S,B); S1:=PureComplexDifference(S,B); M1:=PureComplexDifference(M,B); #return [N,B]; return [M1,S1]; end); ################################################################# ################################################################# ################################################### ################################################### InstallGlobalFunction(MorseFiltration, function(arg) local gradient, M,N,d,bool,dim, dims, G, B, t, J; ################################# gradient:=function(arg) local A,N,J,bool,B,dim,dims,cart, x, ArrayAss; A:=arg[1]; N:=arg[2]; J:=arg[3]; if Length(arg)>3 then bool:=arg[4]; else bool:=true; fi; B:=StructuralCopy(A); dim:=ArrayDimension(A); dims:=ArrayDimensions(A); cart:=List(dims,x->[1..x]); cart:=Cartesian(cart); ArrayAss:=ArrayAssignFunctions(dim); if bool then for x in cart do if x[N]<=J then ArrayAss(B,x,0); fi; od; else for x in cart do if x[N]>=J then ArrayAss(B,x,0); fi; od; fi; return B; end; ################################# M:=arg[1]; N:=arg[2]; d:=arg[3]; if Length(arg)>3 then bool:=arg[4]; else bool:=true; fi; dim:=ArrayDimension(M!.binaryArray); dims:=ArrayDimensions(M!.binaryArray); G:=[]; t:=Int(dims[N]/d); J:=0; while J<dims[N] do B:=StructuralCopy(M!.binaryArray); B:=gradient(B,N,J,bool); B:=PureCubicalComplex(B); Add(G,B); J:=J+t; od; G:=Filtered(G,x->Size(x)>0); if bool then return Reversed(G); else return G; fi; end); ########################################## ########################################## ########################################## ########################################## InstallGlobalFunction(SkeletonOfCubicalComplex, function(MM,K) local M, A,dimsSet,dimsM,Fun,numevens,ArrayIt,ArrayAssignDim, ArrayValueDim,dim; if IsHapPureCubicalComplex(MM) then M:=PureCubicalComplexToCubicalComplex(MM); else M:=MM; fi; if not IsHapCubicalComplex(M) then Print("This functions must be applied to a cubical, or pure cubical, complex.\n"); return fail; fi; dim:=Dimension(M); ArrayValueDim:=ArrayValueFunctions(dim); ArrayAssignDim:=ArrayAssignFunctions(dim); ArrayIt:=ArrayIterate(dim); dimsM:=EvaluateProperty(M,"arraySize"); dimsSet:=List([1..dim],x->[1..dimsM[x]]); ############################## numevens:=function(x); return Length(Filtered(x,i->IsEvenInt(i))); end; ############################## ####################### Fun:=function(x) local y,z; if ArrayValueDim(M!.binaryArray,x)=1 then y:=numevens(x); if y<=K then ArrayAssignDim(A,x,1); fi; fi; end; ####################### A:=StructuralCopy(M!.binaryArray); A:=0*A; ArrayIt(dimsSet,Fun); return Objectify(HapCubicalComplex, rec( binaryArray:=A, properties:=StructuralCopy(M!.properties))); end); ########################################## ########################################## #################################################### #################################################### InstallGlobalFunction(SuspensionOfPureCubicalComplex, function(M) local A,B,C; A:=M!.binaryArray; B:=0*A; B:=1+B; C:=[B,A,B]; Apply(C,a->StructuralCopy(a)); return PureCubicalComplex(C); end); #################################################### #################################################### #################################################### #################################################### InstallGlobalFunction(ReadLinkImageAsPureCubicalComplex, function(arg) local file,thk,M, arcs, S, T, K; file:=arg[1]; if Length(arg)>1 then thk:=arg[2]; else thk:=10; fi; M:=ReadImageAsPureCubicalComplex(file,590); M:=PureCubicalComplex(FrameArray(M!.binaryArray)); M:=PureCubicalComplex(FrameArray(M!.binaryArray)); arcs:=PathComponentOfPureCubicalComplex(M,0); S:=SingularitiesOfPureCubicalComplex(M,thk,50); while PathComponentOfPureCubicalComplex(S,0)>2*arcs or Length(Homology(S,1))>0 do S:=ThickenedPureCubicalComplex(S); od; #Sanity check if not PathComponentOfPureCubicalComplex(S,0)=2*arcs then return fail; fi; T:=ThickenedPureCubicalComplex(S); while PathComponentOfPureCubicalComplex(T,0)>arcs or Length(Homology(T,1))>0 do T:=ThickenedPureCubicalComplex(T); od; #Sanity check if not PathComponentOfPureCubicalComplex(T,0)=arcs then return fail; fi; K:=PureCubicalComplex( FrameArray([T!.binaryArray,S!.binaryArray,S!.binaryArray,M!.binaryArray]) ); K:=PureCubicalComplex(FrameArray(K!.binaryArray)); return K; end); #################################################### #################################################### ########################################## ########################################## #HenonOrbit:=function(x,A,B,K,M,L) InstallGlobalFunction(HenonOrbit, function(arg) local x,A,B,K,M,L,henon, Henon, Roundoff,P,N,DIMS; x:=arg[1]; A:=arg[2]; B:=arg[3]; if Length(arg)>3 then K:=arg[4]; else K:=10^6;fi; if Length(arg)>4 then M:=arg[5]; else M:=1800;fi; if Length(arg)>5 then L:=arg[6]; else L:=20;fi; N:=10^L; ############################# henon:=function(x) local z; z:=[]; z[1]:=x[2]+1-A*x[1]^2; z[2]:=B*x[1]; return z; end; ############################# ############################# Roundoff:=function(x) local r1,r2; r1:=N*x[1]; r1:=Int(r1); r1:=r1/N; r2:=N*x[2]; r2:=Int(r2); r2:=r2/N; return [r1,r2]; end; ############################# ############################# DIMS:=function(xx,k) local Xmax, Ymax, Xmin, Ymin, x,i; x:=Roundoff(xx); Xmax:=Int(M*(x[1]+2)); Xmin:=Int(M*(x[1]-2)); Ymax:=Int(M*(x[2]+2)); Ymin:=Int(M*(x[2]-2)); for i in [1..k] do x:=Roundoff(henon(x)); Xmax:=Maximum(Xmax,Int(M*(x[1]+2))); Ymax:=Maximum(Ymax,Int(M*(x[2]+2))); Xmin:=Minimum(Xmin,Int(M*(x[1]-2))); Ymin:=Minimum(Ymin,Int(M*(x[2]-2))); od; return [Xmin,Xmax,Ymin,Ymax]; end; ############################# if Length(arg)<=6 then ############################# Henon:=function(x,k) local z,i,A, D; D:=DIMS(x,k); A:=NullMat(D[2]-D[1]+10,D[4]-D[3]+10); x:=Roundoff(x); for i in [1..2000] do x:=Roundoff(henon(x)); od; for i in [1..k] do x:=Roundoff(henon(x)); A[Int(M*(x[1]+2))-D[1]+1][Int(D[4]-M*(x[2]+2))+1]:=1; od; return A; end; ############################# else ############################# Henon:=function(x,k) local z,i,A, D, DD; DD:=arg[7]; D:=[]; D[2]:=Int(M*(DD[2]+2)); D[4]:=Int(M*(DD[4]+2)); D[1]:=Int(M*(DD[1]-2)); D[3]:=Int(M*(DD[3]-2)); A:=NullMat(D[2]-D[1]+10,D[4]-D[3]+10); x:=Roundoff(x); for i in [1..2000] do x:=Roundoff(henon(x)); od; for i in [1..k] do x:=Roundoff(henon(x)); if x[1]>DD[1] and x[1]<DD[2] and x[2]>DD[3] and x[2]<DD[4] then A[Int(M*(x[1]+2))-D[1]+1][Int(D[4]-M*(x[2]+2))+1]:=1; fi; od; return A; end; ############################# fi; P:=Henon(x,K); P:=PureCubicalComplex(P); P:=CropPureCubicalComplex(P); P:=FrameArray(P!.binaryArray); P:=PureCubicalComplex(P); return P; end); ############################################## ############################################## ################################################### ################################################### InstallGlobalFunction(RandomCubeOfPureCubicalComplex, function(M) local B, cart, CART, dim,dims, ArrayValueDim, ArrayAssignDim, x,z,cnt, ran; ############################################# if not IsHapPureCubicalComplex(M) then Print("This function must be applied to a pure cubical complex.\n"); return fail; fi; ############################################# dim:=Dimension(M); ran:=Random([1..Size(M)]); cnt:=0; ArrayValueDim:=ArrayValueFunctions(dim); ArrayAssignDim:=ArrayAssignFunctions(dim); dims:=EvaluateProperty(M,"arraySize"); B:=0*M!.binaryArray; CART:=Cartesian(List([1..dim],a->[1..dims[a]])); cart:=Cartesian(List([1..dim],a->[-1,0,1])); for x in CART do if ArrayValueDim(M!.binaryArray,x)=1 then cnt:=cnt+1; fi; if cnt=ran then ArrayAssignDim(B,x,1); break;fi; od; return PureCubicalComplex(B); end); ################################################################# ################################################################# ################################################################# ################################################################# InstallGlobalFunction(FramedPureCubicalComplex, function(M); return PureCubicalComplex(FrameArray(M!.binaryArray)); end); ################################################################# #################################################################