GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
####################################################################### #0 #F ControlledSubdivision ## InstallGlobalFunction(BaryCentricSubdivision, function(C) local Cells,coBoundaries,N,i,Dims,pos,j,x,y,w,id,t,k,ck,c,s,a,v,g,b, Elts,Rep,mult,ListUnion, Chains, IsSameOrbit, AddReturn, Orbit, Dimension, StabRec, Action, Stabilizer, Boundary, NChains, BoundaryRec, FinalBoundary; Elts:=C!.elts; ################################################################## # If g in Elts return the position of g in the list, # otherwise, add g to Elts and return the position. pos:=function(g) local posit; posit:=Position(Elts,g); if posit=fail then Add(Elts,g); return Length(Elts); else return posit; fi; end; ################################################################## # returns a "canonical" representative of the right coset # Elts[g]*Stab[i+1][j] Rep:=function(i,j,g) return pos(CanonicalRightCountableCosetElement (C!.stabilizer(i,j),Elts[g]^-1)^-1); end; ################################################################## AddReturn:=function(a,g) local b; b:=StructuralCopy(a); Add(b,g); return b; end; ################################################################## mult:=function(L,g) return List(L,a->[a[1],pos(Elts[g]*Elts[a[2]])]); end; ################################################################## ListUnion:=function(x,y) local a; for a in y do if not a in x then Add(x,a); fi; od; end; ################################################################## IsSameOrbit:=function(a,b) local s,w,v,x,y,k,g,i; for i in [1..Length(a)] do if not a[i][1]=b[i][1] then return false; fi; od; x:=List([1..Length(a)],i->[a[i][1],Cells[a[i][1]+1][a[i][2]]]); y:=List([1..Length(b)],i->[b[i][1],Cells[b[i][1]+1][b[i][2]]]); for i in [1..Length(x)] do if not x[i][2][1]=y[i][2][1] then return false; fi; od; w:=List(C!.stabilizer(x[1][1],x[1][2][1]),i->Elts[y[1][2][2]]*i*Elts[x[1][2][2]]^-1); for s in [2..Length(x)] do v:=List(C!.stabilizer(x[s][1],x[s][2][1]),i->Elts[y[s][2][2]]*i*Elts[x[s][2][2]]^-1); w:=Intersection(w,v); if IsEmpty(w) then return false;fi; od; if not IsEmpty(w) then return w[1];fi; end; ################################################################## Dims:=[]; for i in [0..Length(C)] do if C!.dimension(i)=0 then N:=i-1; break; fi; Dims[i+1]:=C!.dimension(i); od; Cells:=[]; coBoundaries:=[]; id:=pos(One(C!.group)); for i in [1..N+1] do Cells[i]:=[]; coBoundaries[i]:=[]; od; for j in [1..Dims[N+1]] do Add(Cells[N+1],[j,id]); od; # Construct the list of cells and the corresponding coboundary of those cells i:=N; while i>0 do for k in [1..Length(Cells[i+1])] do x:=Cells[i+1][k]; w:=StructuralCopy(C!.boundary(i,AbsInt(x[1]))); w:=mult(w,x[2]); w:=List(w,a->[AbsInt(a[1]),Rep(i-1,AbsInt(a[1]),a[2])]); ListUnion(Cells[i],w); for y in w do t:=Position(Cells[i],y); if not IsBound(coBoundaries[i][t]) then coBoundaries[i][t]:=[]; fi; Add(coBoundaries[i][t],k); od; od; i:=i-1; od; # Record k-chains as a list Chains:=[]; # Record the 1-chains Chains[1]:=[]; for i in [1..1] do for j in [1..Length(Cells[i])] do Add(Chains[1],[[i-1,j]]); od; od; # Construct the list of N-chains for k in [1..(N)] do Chains[k+1]:=[]; for i in [1..Length(Chains[k])] do ck:=StructuralCopy(Chains[k][i]); c:=ck[k]; w:=List(coBoundaries[c[1]+1][c[2]],x->AddReturn(ck,[c[1]+1,x])); Append(Chains[k+1],w); od; od; NChains:=StructuralCopy(Chains[N+1]); # Recognizing orbits and compute the boundary of cells. Orbit:=[]; Orbit[N+1]:=[]; Add(Orbit[N+1],NChains[1]); for i in [2..Length(NChains)] do for j in [1..Length(Orbit[N+1])] do c:=0; if not IsSameOrbit(NChains[i],Orbit[N+1][j])=false then c:=1; break; fi; od; if c=0 then Add(Orbit[N+1],NChains[i]);fi; od; BoundaryRec:=[]; k:=N+1; while k>1 do BoundaryRec[k-1]:=[]; for i in [1..Length(Orbit[k])] do x:=StructuralCopy(Orbit[k][i]); b:=[]; for j in [1..Length(x)] do w:=StructuralCopy(x); Remove(w,j); if not IsBound(Orbit[k-1]) then Orbit[k-1]:=[]; fi; c:=0; for s in [1..Length(Orbit[k-1])] do g:=IsSameOrbit(Orbit[k-1][s],w); if not g=false then c:=1; Add(b,[(-1)^j*s,pos(g)]); fi; od; if c=0 then Add(Orbit[k-1],w); Add(b,[(-1)^j*Length(Orbit[k-1]),id]); fi; od; BoundaryRec[k-1][i]:=b; od; k:=k-1; od; # Find the k-rank Dimension:=function(k) if k<0 or k>N then return 0;fi; return Length(Orbit[k+1]); end; # Stabilizer subgroup of the representative of the ith-orbit of (k-1)-cells StabRec:=[]; for k in [1..(N+1)] do StabRec[k]:=[]; for i in [1..Dimension(k-1)] do a:=Orbit[k][i]; x:=List([1..Length(a)],w->[a[w][1],Cells[a[w][1]+1][a[w][2]]]); w:=ConjugateGroup(C!.stabilizer(a[1][1],x[1][2][1]),Elts[x[1][2][2]]^-1); for s in [2..Length(x)] do v:=ConjugateGroup(C!.stabilizer(a[s][1],x[s][2][1]),Elts[x[s][2][2]]^-1); w:=Intersection(w,v); od; StabRec[k][i]:=w; od; od; Stabilizer:=function(k,i) return StabRec[k+1][i]; end; # The cell structure is rigid under the action of G then Action(k,i,j) always be 1. Action:=function(k,i,j) return 1; end; # Calculate the boundary of the representative of the ith-orbit of k-cells Boundary:=function(n,k) if k>0 then return BoundaryRec[n][k]; else return NegateWord(BoundaryRec[n][AbsInt(k)]); fi; end; ################################################################## return Objectify(HapNonFreeResolution, rec( dimension:=Dimension, Orbit:=Orbit, Cells:=Cells, Chains:=Chains, boundary:=Boundary, coBoundaries:=coBoundaries, IsSameOrbit:=IsSameOrbit, homotopy:=fail, elts:=Elts, group:=C!.group, stabilizer:=Stabilizer, action:=Action, properties:= [["length",Maximum(1000,N)], ["characteristic",0], ["type","resolution"]] )); end); ################### end of ControlledSubdivision ############################