fundamental.new

#(C) Graham Ellis

##########################################################
##########################################################
InstallGlobalFunction(FundamentalGroupOfRegularCWComplex,
function(arg)
local P,Y,base,e,bool, b, vertices,edges,F, G, r,x,w, gens, rels, 
      cells, 0cells,1cells, 2cells, 2boundaries, deform, EdgeToWord,
      EdgeToLoop, VertexToPath, loops, OrderPath;

Y:=arg[1];

if Length(arg)>1 then base:=arg[2]; else base:=1; fi;


if Dimension(Y)<4 then
cells:=CriticalCellsOfRegularCWComplex(Y);
else
cells:=CocriticalCellsOfRegularCWComplex(Y,3);
fi;
Y!.criticalCells:=cells;
0cells:=Filtered(cells,x->x[1]=0);
Apply(0cells,x->x[2]);
1cells:=Filtered(cells,x->x[1]=1);
Apply(1cells,x->x[2]);
2cells:=Filtered(cells,x->x[1]=2);
Apply(2cells,x->x[2]);
2boundaries:=List(2cells,x->[Y!.boundaries[3][x],Y!.orientation[3][x]]);
Apply(2boundaries,x->[x[1]{[2..Length(x[1])]},x[2]]);
Apply(2boundaries,x->List([1..Length(x[1])],i->x[1][i]*x[2][i]));

###########################
OrderPath:=function(x)
local path, verts, n, v, b, pos;

if Length(x)=0 then return x; fi;

path:=[x[1]];
if x[1]>0 then
v:=Y!.boundaries[2][AbsInt(x[1])][3];
else
v:=Y!.boundaries[2][AbsInt(x[1])][2];
fi;
verts:=[v];
Remove(x,1);

while Length(x)>0 do
n:=Length(path);
b:=Y!.boundaries[2][AbsInt(path[n])]{[2,3]}; 
if b[1] in verts then v:=b[2]; else v:=b[1]; fi;
AddSet(verts,v);
pos:=PositionProperty(x,i-> v in Y!.boundaries[2][AbsInt(i)]{[2,3]});
path[n+1]:=x[pos];
Remove(x,pos);
od;

return path;
end;
###########################

Apply(2boundaries,OrderPath);

deform:=ChainComplex(Y)!.homotopicalDeform;
Apply(2boundaries,x->Flat(List(x,a->deform(1,a))));


vertices:=[deform(0,base)];
edges:=[];
###################################
###################################
if not Length(0cells)=1 then 

bool:=true;
while bool do
bool:=false;

for e in 1cells do
b:=Y!.boundaries[2][e];
b:=b{[2,3]};
Apply(b,x->deform(0,x));

if b[1] in vertices and not b[2] in vertices
then Add(edges,e); Add(vertices,b[2]); bool:=true;
fi;
if b[2] in vertices and not b[1] in vertices
then Add(edges,e); Add(vertices,b[1]); bool:=true;
fi;
od;

od;

1cells:=Difference(1cells,edges);

1cells:=Filtered(1cells,e->deform(0,Y!.boundaries[2][e][2]) in vertices);
2cells:=Filtered(2cells,e->deform(1,Y!.boundaries[3][e][2]) in 1cells);
fi;
###################################
###################################

F:=FreeGroup(Length(1cells));
gens:=GeneratorsOfGroup(F);
if Length(gens)=0 then return F; fi;
rels:=[];
for r in 2boundaries do
w:=Identity(F);
for x in r do
if (not AbsInt(x) in edges) and deform(0,Y!.boundaries[2][AbsInt(x)][2]) in vertices then
w:=w*gens[Position(1cells,AbsInt(x))]^(SignInt(x));
fi;
od;


Add(rels,w);
od;

P:=PresentationFpGroup(F/rels);
if Length(arg)<3 then SimplifyPresentation(P);; fi;

##############################################
EdgeToWord:=function(e)
local r, x, w;

r:=Flat(deform(1,e));

w:=Identity(F);
for x in r do
if (not AbsInt(x) in edges) and deform(0,Y!.boundaries[2][AbsInt(x)][2]) in vertices then
w:=w*gens[Position(1cells,AbsInt(x))]^(SignInt(x));
fi;
od;

return w;

end;
##############################################

G:=FpGroupPresentation(P);

G!.edgeToWord:=EdgeToWord;
loops:=StructuralCopy(1cells);

########################
VertexToPath:=function(v)
local path, e, pos;

path:=[];

while true do
if [v] in vertices then return path; 
else
e:=Y!.inverseVectorField[1][v];
w:=Y!.boundaries[2][e];
w:=w{[2,3]};
pos:=Position(w,v);
if pos=2 then v:=w[1]; Add(path,e); else v:=w[2]; Add(path,-e); fi;
fi;
od;

end;
########################

########################
EdgeToLoop:=function(e)
local loop, b;

b:=Y!.boundaries[2][e];
loop:=-Reversed(VertexToPath(b[2]));
Add(loop,e);
Append(loop,VertexToPath(b[3]));
return loop;
end;
########################

if Length(arg)>2 then
Apply(loops,EdgeToLoop);
G!.loops:=loops;
fi;

return G;

end);
##########################################################
##########################################################

##########################################################
##########################################################
InstallMethod(FundamentalGroup,
"for regular CW-complexes",
[IsHapRegularCWComplex],
function(Y)
local F;
F:= FundamentalGroupOfRegularCWComplex(Y);
return F;
end);
##########################################################
##########################################################

##########################################################
##########################################################
InstallMethod(FundamentalGroup,
"for regular CW-complex",
[IsHapRegularCWComplex,IsInt],
function(Y,n)
local bool,F;
F:= FundamentalGroupOfRegularCWComplex(Y,n);
return F;
end);
##########################################################
##########################################################

##########################################################
##########################################################
InstallOtherMethod(FundamentalGroup,
"for simplicial complexes",
[IsHapSimplicialComplex],
function(K)
local Y,c;
if Dimension(K)=2 then
return FundamentalGroupSimplicialTwoComplex(K);
fi;
Y:=SimplicialComplexToRegularCWComplex(K,3);;
c:=CocriticalCellsOfRegularCWComplex(Y,3);
return FundamentalGroup(Y);
end);
##########################################################
##########################################################

##########################################################
##########################################################
InstallOtherMethod(FundamentalGroup,
"for  pure cubical complexes",
[IsHapPureCubicalComplex],
function(M)
local Y,c;
Y:=CubicalComplexToRegularCWComplex(M,3);;
if Dimension(Y)<4 then 
c:=CriticalCellsOfRegularCWComplex(Y);
else
c:=CocriticalCellsOfRegularCWComplex(Y,3);
fi;
return FundamentalGroup(Y);
end);
##########################################################
##########################################################

##########################################################
##########################################################
InstallOtherMethod(FundamentalGroup,
"for  pure Regular CW-Maps",
[IsHapRegularCWMap],
function(map);
return FundamentalGroupOfRegularCWMap(map);
end);
##########################################################
##########################################################

##########################################################
##########################################################
InstallOtherMethod(FundamentalGroup,
"for  pure Regular CW-Maps with specified base-point",
[IsHapRegularCWMap,IsInt],
function(map,base);
return FundamentalGroupOfRegularCWMap(map,base);
end);
##########################################################
##########################################################


##########################################################
##########################################################
InstallOtherMethod(FundamentalGroup,
"for cubical complexes",
[IsHapCubicalComplex],
function(M)
local Y,c;
Y:=CubicalComplexToRegularCWComplex(M,3);;
if Dimension(Y)<4 then
c:=CriticalCellsOfRegularCWComplex(Y);
else
c:=CocriticalCellsOfRegularCWComplex(Y,3);
fi;
return FundamentalGroup(Y);
end);
##########################################################
##########################################################



#################################################
#################################################
InstallGlobalFunction(BoundaryPairOfPureRegularCWComplex,
function(Y)
local B, map, perm,invperm, x, pm, cnt;

B:=BoundaryOfPureRegularCWComplex(Y);
perm:=B!.perm;
invperm:=List([1..Length(perm)],i->[]);
for x in [1..Length(perm)] do
pm:=perm[x];
cnt:=0;
while cnt<Length(pm) do
cnt:=cnt+1;
if IsBound(pm[cnt]) then invperm[x][pm[cnt]]:=cnt; fi;
od;
od;

#########################
map:=function(n,i);
return invperm[n+1][i];
end;
#########################

return Objectify(HapRegularCWMap,
       rec(
           source:=B,
           target:=Y,
           mapping:=map));
end);
#################################################
#################################################

#################################################
#################################################
InstallOtherMethod(Source,
"Source of a RegularCWMap",
[IsHapRegularCWMap],
function(map)
return map!.source;
end);
#################################################
#################################################

#################################################
#################################################
InstallOtherMethod(Target,
"Target of a RegularCWMap",
[IsHapRegularCWMap],
function(map)
return map!.target;
end);
#################################################
#################################################


#################################################
#################################################
InstallGlobalFunction(FundamentalGroupOfRegularCWMap,
function(arg)
local map, pntS, pntT,GS, GT, S, T, mapfn, loops,gensS, x, w;

map:=arg[1];
S:=Source(map);
T:=Target(map);
mapfn:=map!.mapping;

if Length(arg)>1 then pntS:=arg[2]; else pntS:=1; fi;
pntT:=mapfn(0,pntS);

GS:=FundamentalGroupOfRegularCWComplex(S,pntS,"nosimplify");
GT:=FundamentalGroupOfRegularCWComplex(T,pntT,"nosimplify");

gensS:=GeneratorsOfGroup(GS);

if Length(gensS)=0 then return
GroupHomomorphismByImagesNC(Group(Identity(GT)),GT,[Identity(GT)],[Identity(GT)]); fi;

loops:=[];
for x in GS!.loops do
w:= List(x,i->SignInt(i)*mapfn(1,AbsInt(i))) ;

Apply(w,i->GT!.edgeToWord(AbsInt(i))^SignInt(i));

Add(loops, Product(w));
od;

return GroupHomomorphismByImagesNC(GS,GT,gensS,loops);;
end);
#################################################
#################################################