GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
######################################################################
######################################################################
InstallGlobalFunction(BettinumbersOfPureCubicalComplex_dim_2,
function(AA)
local
A,B,i,j,
Neighbours,
rows,cols,firstBetti,
box,
colour,
ChooseBox,
neibs, newneibs,
EdgeCount,
VertexCount,
Edges,
Vertices,
Faces,
NeighbourValues,
v,vv;
A:=FrameArray(AA!.binaryArray);
#if EvaluateProperty(AA,"contracted")=fail then
#ContractMatrix(A);
#fi;
B:=StructuralCopy(A);
rows:=Length(A);
cols:=Length(A[1]);
Edges:=0;
Vertices:=0;
Faces:=0;
#####################################################################
ChooseBox:=function(A)
local i,j, col, row;
row:=Length(A);
col:=Length(A[1]);
for i in [1..row] do
for j in [1..col] do
if A[i][j]=1 then return [i,j]; fi;
od;
od;
return fail;
end;
#####################################################################
#####################################################################
Neighbours:=function(B,box)
local nbs;
nbs:=[
[box[1]-1,box[2]-1],
[box[1]-1,box[2]],
[box[1]-1,box[2]+1],
[box[1],box[2]-1],
[box[1],box[2]+1],
[box[1]+1,box[2]-1],
[box[1]+1,box[2]],
[box[1]+1,box[2]+1]
];
return Filtered(nbs,x->B[x[1]][x[2]]=1);
end;
####################################################################
#####################################################################
NeighbourValues:=function(A,box)
local left,top,right,bottom,topleft,topright,bottomleft,bottomright;
left:=A[box[1]][box[2]-1];
right:=A[box[1]][box[2]+1];
top:=A[box[1]-1][box[2]];
bottom:=A[box[1]+1][box[2]];
topleft:=A[box[1]-1][box[2]-1];
topright:=A[box[1]-1][box[2]+1];
bottomleft:=A[box[1]+1][box[2]-1];
bottomright:=A[box[1]+1][box[2]+1];
return [left,topleft,top,topright,right,bottomright,bottom,bottomleft];
end;
######################################################################
####################################################################
box:=ChooseBox(B);
colour:=1;
while not box=fail do
colour:=colour+1;
B[box[1]][box[2]]:=colour;
vv:=NeighbourValues(A,box);
Vertices:=Vertices+
1/(1+vv[1]+vv[2]+vv[3]) +1/(1+vv[3]+vv[4]+vv[5])
+1/(1+vv[5]+vv[6]+vv[7]) +1/(1+vv[7]+vv[8]+vv[1]);
Edges:=Edges+4-Sum(vv{[1,3,5,7]})/2;
Faces:=Faces+1;
neibs:=Neighbours(B,box);
while Length(neibs)>0 do
for box in neibs do
B[box[1]][box[2]]:=colour;
v:=NeighbourValues(A,box);
Vertices:=Vertices+
1/(1+v[1]+v[2]+v[3]) +1/(1+v[3]+v[4]+v[5])
+1/(1+v[5]+v[6]+v[7]) +1/(1+v[7]+v[8]+v[1]);
Edges:=Edges+4-Sum(v{[1,3,5,7]})/2;
Faces:=Faces+1;
od;
newneibs:=Concatenation(List(neibs,x->Neighbours(B,x)));
neibs:=SSortedList(newneibs);
od;
box:=ChooseBox(B);
od;
return [colour-1, colour-Faces+Edges-Vertices-1, 0];
end);
######################################################################
######################################################################
######################################################################
######################################################################
InstallGlobalFunction(ContractMatrix,
function(A);
return HomotopyEquivalentSmallerSubMatrix(A,A*0);
end);
######################################################################
######################################################################
HAP_MOVES_DIM_2:=0;
#####################################################################
#####################################################################
InstallGlobalFunction(HomotopyEquivalentSmallerSubMatrix,
function(AA,SS)
local
A,S,
tog,
col,
row,
i,j,ii,jj,
left,top,right,bottom,topleft,topright,bottomleft,bottomright;
if HAP_MOVES_DIM_2=0 then
ReadPackage("HAP","lib/PolyComplexes/hapMovesDim2B.txt");
fi;
A:=FrameArray(AA);
S:=FrameArray(SS);
row:=Length(A);
col:=Length(A[1]);
tog:=true;
######################################################
while tog do
tog:=false;
for i in [1..row] do
for j in [1..col] do
if A[i][j]=1 and S[i][j]=0 then
left:=A[i][j-1];
right:=A[i][j+1];
top:=A[i-1][j];
bottom:=A[i+1][j];
topleft:=A[i-1][j-1];
topright:=A[i-1][j+1];
bottomleft:=A[i+1][j-1];
bottomright:=A[i+1][j+1];
if
HAP_MOVES_DIM_2[1+left+2*topleft+4*top+8*topright+16*right+32*bottomright+64*bottom+128*bottomleft]
then A[i][j]:=0; tog:=true;
fi;
fi;
od;
od;
if tog then
for ii in [1..row] do
for jj in [1..col] do
i:=row+1-ii;j:=col+1-jj;
if A[i][j]=1 and S[i][j]=0 then
left:=A[i][j-1];
right:=A[i][j+1];
top:=A[i-1][j];
bottom:=A[i+1][j];
topleft:=A[i-1][j-1];
topright:=A[i-1][j+1];
bottomleft:=A[i+1][j-1];
bottomright:=A[i+1][j+1];
if
HAP_MOVES_DIM_2[1+left+2*topleft+4*top+8*topright+16*right+32*bottomright+64*bottom+128*bottomleft]
then A[i][j]:=0; tog:=true;
fi;
fi;
od;
od;
fi;
od;
#############################################
return UnframeArray(A);
end);
######################################################################
######################################################################
#####################################################################
#####################################################################
InstallGlobalFunction(ContractibleSubMatrix,
function(AA);
return HomotopyEquivalentLargerSubMatrix(AA,AA*0);
end);
#####################################################################
#####################################################################
#####################################################################
#####################################################################
InstallGlobalFunction(HomotopyEquivalentLargerSubMatrix,
function(AA,BB)
local
A,B,
tog,
col,
row,
start,
i,j,ii,jj,
left,top,right,bottom,topleft,topright,bottomleft,bottomright;
if HAP_MOVES_DIM_2=0 then
ReadPackage("HAP","lib/PolyComplexes/hapMovesDim2B.txt");
fi;
A:=FrameArray(AA);
B:=FrameArray(BB);
row:=Length(A);
col:=Length(A[1]);
##If B is empty then###############################
if ArraySum(B)=0 then
start:=0;
############################
for i in [1..row] do
for j in [1..col] do
if A[i][j]=1 then
start:=[i,j]; break; fi;
od;
if IsList(start) then break; fi;
od;
############################
#B:=A*0;
B[start[1]][start[2]]:=1;
fi;
##B is now probably non-empty######################
tog:=true;
while tog do
tog:=false;
for i in [1..row] do
for j in [1..col] do
if A[i][j]=1 and B[i][j]=0 then
left:=B[i][j-1];
right:=B[i][j+1];
top:=B[i-1][j];
bottom:=B[i+1][j];
topleft:=B[i-1][j-1];
topright:=B[i-1][j+1];
bottomleft:=B[i+1][j-1];
bottomright:=B[i+1][j+1];
if
HAP_MOVES_DIM_2[1+left+2*topleft+4*top+8*topright+16*right+32*bottomright+64*bottom+128*bottomleft]
then B[i][j]:=1; tog:=true;
fi;
fi;
od;
od;
if tog then
for ii in [1..row] do
i:=row-ii+1;
for jj in [1..col] do
j:=col-jj+1;
if A[i][j]=1 and B[i][j]=0 then
left:=B[i][j-1];
right:=B[i][j+1];
top:=B[i-1][j];
bottom:=B[i+1][j];
topleft:=B[i-1][j-1];
topright:=B[i-1][j+1];
bottomleft:=B[i+1][j-1];
bottomright:=B[i+1][j+1];
if
HAP_MOVES_DIM_2[1+left+2*topleft+4*top+8*topright+16*right+32*bottomright+64*bottom+128*bottomleft]
then B[i][j]:=1; tog:=true;
fi;
fi;
od;
od;
fi;
od;
return UnframeArray(B);
end);
#####################################################################
#####################################################################
#####################################################################
#####################################################################
InstallGlobalFunction(ThickenedPureCubicalComplex_dim2,
function(M)
local
A,B,rows,cols,ball,x,i,j;
A:=FrameArray(M!.binaryArray);
B:=A*0;
rows:=Length(B);
cols:=Length(B[1]);
ball:=Cartesian([-1,0,1],[-1,0,1]);
#RemoveSet(ball,[0,0]);
for i in [2..rows-1] do
for j in [2..cols-1] do
if A[i][j]=1 then
for x in ball do
B[i+x[1]][j+x[2]]:=1;
od;
fi;
od;
od;
B:=UnframeArray(B);
return PureCubicalComplex(B);
end);
#####################################################################
#####################################################################
#####################################################################
#####################################################################
InstallGlobalFunction(ThickenedHEPureCubicalComplex,
function(M)
local
A,B,rows,cols,ball,x,i,j,left,right,top,bottom,topleft,topright,bottomleft, bottomright;
A:=FrameArray(M!.binaryArray);
A:=FrameArray(A);
B:=A*1;
rows:=Length(B);
cols:=Length(B[1]);
ball:=Cartesian([-1,0,1],[-1,0,1]);
#RemoveSet(ball,[0,0]);
if HAP_MOVES_DIM_2=0 then
ReadPackage("HAP","lib/PolyComplexes/hapMovesDim2B.txt");
fi;
for i in [2..rows-1] do
for j in [2..cols-1] do
if A[i][j]=1 then
for x in ball do
if B[i+x[1]][j+x[2]]=0 then
###
left:=B[i+x[1]][j-1+x[2]];
right:=B[i+x[1]][j+1+x[2]];
top:=B[i-1+x[1]][j+x[2]];
bottom:=B[i+1+x[1]][j+x[2]];
topleft:=B[i-1+x[1]][j-1+x[2]];
topright:=B[i-1+x[1]][j+1+x[2]];
bottomleft:=B[i+1+x[1]][j-1+x[2]];
bottomright:=B[i+1+x[1]][j+1+x[2]];
if
HAP_MOVES_DIM_2[1+left+2*topleft+4*top+8*topright+16*right+32*bottomright+64*bottom+128*bottomleft]
then; B[i+x[1]][j+x[2]]:=1;
fi;
###
fi;
od;
fi;
od;
od;
B:=UnframeArray(B);
B:=UnframeArray(B);
return PureCubicalComplex(B);
end);
#####################################################################
#####################################################################
#####################################################################
#####################################################################
InstallGlobalFunction(ExcisedPureCubicalPair_dim_2,
function(M,S)
local
A,B,C,D,rows,cols,ball,x,i,j,tog;
A:=FrameArray(M!.binaryArray);
B:=A*0;D:=A*0;
C:=FrameArray(S!.binaryArray);
rows:=Length(B);
cols:=Length(B[1]);
ball:=Cartesian([-1,0,1],[-1,0,1]);
for i in [2..rows-1] do
for j in [2..cols-1] do
if C[i][j]=1 then
tog:=false;
for x in ball do
if C[i+x[1]][j+x[2]]=0 then tog:=true; break;fi;
od;
if tog then B[i][j]:=1; fi;
fi;
od;
od;
for i in [2..rows-1] do
for j in [2..cols-1] do
if A[i][j]=1 and ( C[i][j]=0 or B[i][j]=1) then D[i][j]:=1; fi;
od;
od;
B:=UnframeArray(B);
D:=UnframeArray(D);
return [PureCubicalComplex(D), PureCubicalComplex(B)];
end);
#####################################################################
#####################################################################