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