1#(C) Graham Ellis 2 3########################################################## 4########################################################## 5InstallGlobalFunction(FundamentalGroupOfRegularCWComplex, 6function(arg) 7local P,Y,base,e,bool, b, vertices,edges,F, G, FhomG, r,x,w, gens, rels, 8 cells, 0cells,1cells, 2cells, 2boundaries, deform, EdgeToWord, 9 EdgeToLoop, VertexToPath, loops, BOOL, homotopyOrientation,R,S,SS,i,ii,jj, bnd,sn, y, j, 10 indx, A, B, fn,LL; 11 12Y:=arg[1]; 13base:=1; 14BOOL:=true; 15 16if Length(arg)>1 then 17if IsInt(arg[2]) then base:=arg[2]; fi; 18if IsString(arg[2]) then BOOL:=false; fi; 19fi; 20 21if Length(arg)>2 then 22if IsInt(arg[3]) then base:=arg[3]; fi; 23if IsString(arg[3]) then BOOL:=false; fi; 24fi; 25 26 27 28if Dimension(Y)<4 then 29 cells:=CriticalCellsOfRegularCWComplex(Y); 30# cells:=CocriticalCellsOfRegularCWComplex(Y,4); 31else 32 if IsBound(Y!.allcocriticalcells) then 33 cells:=CocriticalCellsOfRegularCWComplex(Y,Y!.allcocriticalcells); 34 else 35 cells:=CocriticalCellsOfRegularCWComplex(Y,3); 36 fi; 37fi; 38Y!.criticalCells:=cells; 39 40########################################################### 41P:=SSortedList(List(Y!.orientation[2],Sum)); # changed 1 to 2 (Nov 2019) 42if P=[0] then Y!.homotopyOrientation:=Y!.orientation{[1,2,3]}; 43else 44P:=TruncatedRegularCWComplex(Y,2);; 45P!.orientation:=fail; 46OrientRegularCWComplex(P); 47Y!.homotopyOrientation:=P!.orientation; 48fi; 49Unbind(P); 50########################################################### 510cells:=Filtered(cells,x->x[1]=0); 52Apply(0cells,x->x[2]); 531cells:=Filtered(cells,x->x[1]=1); 54Apply(1cells,x->x[2]); 552cells:=Filtered(cells,x->x[1]=2); 56Apply(2cells,x->x[2]); 572boundaries:=1*List(2cells,x->[Y!.boundaries[3][x],Y!.homotopyOrientation[3][x]]); 58Apply(2boundaries,x->[x[1]{[2..Length(x[1])]},x[2]]); 59 60 61##NEED TO ORDER EACH BOUNDARY #CHANGED 27/11/2018 62for i in [1..Length(2boundaries)] do 63R:=1*2boundaries[i]; 64S:=[1]; #SS:=[1]; 65indx:=[2..Length(R[1])]; 66for ii in [1..Length(R[1])-1] do 67A:=Y!.boundaries[2][R[1][S[ii]]]; 68A:=A{[2,3]}; 69for jj in indx do 70B:=Y!.boundaries[2][R[1][jj]]; 71B:=B{[2,3]}; 72if Length(Intersection(A,B))>0 then 73Add(S,jj); 74RemoveSet(indx,jj); 75break; 76fi; 77od; 78od; 79 802boundaries[i]:=[2boundaries[i][1]{S},2boundaries[i][2]{S}]; 81od; 82##BOUNDARIES ORDERED 83 84for j in [1..Length(2boundaries)] do 85sn:=[]; 86bnd:=2boundaries[j][1]; 87###### This is a really thoutless way to get the signs right!!! 88###### And it is also wasteful of time. 89A:=[Y!.boundaries[2][bnd[1]]{[2,3]}]; 90for i in [2..Length(bnd)] do 91x:=Y!.boundaries[2][bnd[i]]{[2,3]}; y:=A[Length(A)];; 92if x[1] in y then sn[i]:=Y!.homotopyOrientation[2][bnd[i]][1]; Add(A,x{[1,2]}); 93else sn[i]:=-Y!.homotopyOrientation[2][bnd[i]][1]; Add(A,x{[2,1]}); fi; 94od; 95if A[1][1] in A[2] then A[1]:=A[1]{[2,1]}; sn[1]:=-Y!.homotopyOrientation[2][bnd[1]][1]; 96else sn[1]:=Y!.homotopyOrientation[2][bnd[1]][1]; fi; 972boundaries[j][2]:=sn; 98###### 99###### 100######################################## 101od; 102 103 104 105 106Apply(2boundaries,x->List([1..Length(x[1])],i->x[1][i]*x[2][i])); 107 108 109 110deform:=ChainComplex(Y)!.homotopicalDeform; 111 112Apply(2boundaries,x->Flat(List(x,a->deform(1,a)))); 113 114vertices:=[deform(0,base)]; 115edges:=[]; 116################################### 117################################### 118if not Length(0cells)=1 then 119 120bool:=true; 121while bool do 122bool:=false; 123 124for e in 1cells do 125b:=Y!.boundaries[2][e]; 126b:=b{[2,3]}; 127Apply(b,x->deform(0,x)); 128 129if b[1] in vertices and not b[2] in vertices 130then Add(edges,e); Add(vertices,b[2]); bool:=true; 131fi; 132if b[2] in vertices and not b[1] in vertices 133then Add(edges,e); Add(vertices,b[1]); bool:=true; 134fi; 135od; 136 137od; 138 1391cells:=Difference(1cells,edges); 140 1411cells:=Filtered(1cells,e->deform(0,Y!.boundaries[2][e][2]) in vertices); 1422cells:=Filtered(2cells,e->deform(1,Y!.boundaries[3][e][2]) in 1cells); 143fi; 144################################### 145################################### 146 147 148F:=FreeGroup(Length(1cells)); 149gens:=GeneratorsOfGroup(F); 150if Length(gens)=0 then return F; fi; 151rels:=[]; 152for r in 2boundaries do 153 154w:=Identity(F); 155for x in r do 156if (not AbsInt(x) in edges) and deform(0,Y!.boundaries[2][AbsInt(x)][2]) in vertices then 157w:=w*gens[Position(1cells,AbsInt(x))]^(SignInt(x)); 158fi; 159od; 160 161Add(rels,w); 162od; 163 164if BOOL then 165P:=PresentationFpGroup(F/rels); 166SimplifyPresentation(P);; 167G:=FpGroupPresentation(P); 168 169else 170 171G:=F/rels; 172FhomG:=GroupHomomorphismByImagesNC(F,G,GeneratorsOfGroup(F),GeneratorsOfGroup(G)); 173fi; 174 175############################################## 176EdgeToWord:=function(e) 177local r, x, w; 178 179#r:=Flat(deform(1,e)); ###changed 180r:=deform(1,e); 181 182 183w:=Identity(F); 184for x in r do 185if (not AbsInt(x) in edges) and deform(0,Y!.boundaries[2][AbsInt(x)][2]) in vertices then 186w:=w*gens[Position(1cells,AbsInt(x))]^(SignInt(x)) ; 187fi; 188od; 189 190return Image(FhomG,w); 191 192end; 193############################################## 194 195if not BOOL then 196G!.edgeToWord:=EdgeToWord; 197fi; 198 199loops:=StructuralCopy(1cells); 200 201######################## 202VertexToPath:=function(v) 203local path, e, pos; 204 205 206path:=[]; 207 208while true do 209if [v] in vertices then return path; 210else 211e:=Y!.inverseVectorField[1][v]; 212w:=Y!.boundaries[2][e]; 213w:=w{[2,3]}; 214pos:=Position(w,v); 215if pos=2 then v:=w[1]; Add(path,-e); else v:=w[2]; Add(path,e); fi; 216fi; 217od; 218 219end; 220######################## 221 222######################## 223EdgeToLoop:=function(e) 224local loop, b; 225 226b:=Y!.boundaries[2][e]; 227loop:=-Reversed(VertexToPath(b[2])); 228Add(loop,e); 229Append(loop,VertexToPath(b[3])); 230return loop; 231end; 232######################## 233 234if Length(arg)>2 then 235Apply(loops,EdgeToLoop); 236G!.loops:=loops; 237fi; 238 239return G; 240 241end); 242########################################################## 243########################################################## 244 245########################################################## 246########################################################## 247InstallMethod(FundamentalGroup, 248"for regular CW-complexes", 249[IsHapRegularCWComplex], 250function(Y) 251local F; 252F:= FundamentalGroupOfRegularCWComplex(Y); 253return F; 254end); 255########################################################## 256########################################################## 257 258########################################################## 259########################################################## 260InstallMethod(FundamentalGroup, 261"for regular CW-complex", 262[IsHapRegularCWComplex,IsInt], 263function(Y,n) 264local bool,F; 265F:= FundamentalGroupOfRegularCWComplex(Y,n); 266return F; 267end); 268########################################################## 269########################################################## 270 271########################################################## 272########################################################## 273InstallOtherMethod(FundamentalGroup, 274"for simplicial complexes", 275[IsHapSimplicialComplex], 276function(K) 277local Y,c; 278if Dimension(K)=2 then 279return FundamentalGroupSimplicialTwoComplex(K); 280fi; 281Y:=SimplicialComplexToRegularCWComplex(K,3);; 282c:=CocriticalCellsOfRegularCWComplex(Y,3); 283return FundamentalGroup(Y); 284end); 285########################################################## 286########################################################## 287 288########################################################## 289########################################################## 290InstallOtherMethod(FundamentalGroup, 291"for pure cubical complexes", 292[IsHapPureCubicalComplex], 293function(M) 294local Y,c; 295Y:=CubicalComplexToRegularCWComplex(M,3);; 296if Dimension(Y)<4 then 297c:=CriticalCellsOfRegularCWComplex(Y); 298else 299c:=CocriticalCellsOfRegularCWComplex(Y,3); 300fi; 301return FundamentalGroup(Y); 302end); 303########################################################## 304########################################################## 305 306########################################################## 307########################################################## 308InstallOtherMethod(FundamentalGroup, 309"for pure permutahedral complexes", 310[IsHapPurePermutahedralComplex], 311function(M) 312local Y,c; 313Y:=RegularCWComplex(M);; 314if Dimension(Y)<4 then 315c:=CriticalCellsOfRegularCWComplex(Y); 316else 317c:=CocriticalCellsOfRegularCWComplex(Y,3); 318fi; 319return FundamentalGroup(Y); 320end); 321########################################################## 322########################################################## 323 324 325########################################################## 326########################################################## 327InstallOtherMethod(FundamentalGroup, 328"for pure Regular CW-Maps", 329[IsHapRegularCWMap], 330function(map); 331return FundamentalGroupOfRegularCWMap(map); 332end); 333########################################################## 334########################################################## 335 336 337 338########################################################## 339########################################################## 340InstallOtherMethod(FundamentalGroup, 341"for pure Regular CW-Maps with specified base-point", 342[IsHapRegularCWMap,IsInt], 343function(map,base); 344return FundamentalGroupOfRegularCWMap(map,base); 345end); 346########################################################## 347########################################################## 348 349 350########################################################## 351########################################################## 352InstallOtherMethod(FundamentalGroup, 353"for cubical complexes", 354[IsHapCubicalComplex], 355function(M) 356local Y,c; 357Y:=CubicalComplexToRegularCWComplex(M,3);; 358if Dimension(Y)<4 then 359c:=CriticalCellsOfRegularCWComplex(Y); 360else 361c:=CocriticalCellsOfRegularCWComplex(Y,3); 362fi; 363return FundamentalGroup(Y); 364end); 365########################################################## 366########################################################## 367 368 369 370################################################# 371################################################# 372InstallGlobalFunction(BoundaryPairOfPureRegularCWComplex, 373function(Y) 374local B, map, perm,invperm, x, pm, cnt; 375 376B:=BoundaryOfPureRegularCWComplex(Y); 377perm:=B!.perm; 378invperm:=List([1..Length(perm)],i->[]); 379for x in [1..Length(perm)] do 380pm:=perm[x]; 381cnt:=0; 382while cnt<Length(pm) do 383cnt:=cnt+1; 384if IsBound(pm[cnt]) then invperm[x][pm[cnt]]:=cnt; fi; 385od; 386od; 387 388######################### 389map:=function(n,i); 390return 1*invperm[n+1][i]; 391end; 392######################### 393 394return Objectify(HapRegularCWMap, 395 rec( 396 source:=B, 397 target:=Y, 398 mapping:=map)); 399end); 400################################################# 401################################################# 402 403################################################# 404################################################# 405InstallOtherMethod(Source, 406"Source of a RegularCWMap", 407[IsHapRegularCWMap], 408function(map) 409return map!.source; 410end); 411################################################# 412################################################# 413 414################################################# 415################################################# 416InstallOtherMethod(Target, 417"Target of a RegularCWMap", 418[IsHapRegularCWMap], 419function(map) 420return map!.target; 421end); 422################################################# 423################################################# 424 425 426################################################# 427################################################# 428InstallGlobalFunction(FundamentalGroupOfRegularCWMap, 429function(arg) 430local map, pntS, pntT,GS, GT, S, T, mapfn, loops,gensS, x, w; 431 432map:=arg[1]; 433S:=Source(map); 434T:=Target(map); 435mapfn:=map!.mapping; 436 437if Length(arg)>1 then pntS:=arg[2]; else pntS:=1; fi; 438pntT:=mapfn(0,pntS); 439 440GS:=FundamentalGroupOfRegularCWComplex(S,pntS,"nosimplify"); 441GT:=FundamentalGroupOfRegularCWComplex(T,pntT,"nosimplify"); 442 443gensS:=GeneratorsOfGroup(GS); 444 445if Length(gensS)=0 then return 446GroupHomomorphismByImagesNC(Group(Identity(GT)),GT,[Identity(GT)],[Identity(GT)]); fi; 447 448loops:=[]; 449for x in GS!.loops do 450w:= List(x,i->SignInt(i)*mapfn(1,AbsInt(i))) ; 451 452#Apply(w,i->GT!.edgeToWord(AbsInt(i))^SignInt(i)); 453#change: 454Apply(w,GT!.edgeToWord); 455 456Add(loops, Product(w)); 457od; 458 459return GroupHomomorphismByImagesNC(GS,GT,gensS,loops);; 460end); 461################################################# 462################################################# 463 464 465