Real-time collaboration for Jupyter Notebooks, Linux Terminals, LaTeX, VS Code, R IDE, and more,
all in one place.
Real-time collaboration for Jupyter Notebooks, Linux Terminals, LaTeX, VS Code, R IDE, and more,
all in one place.
| Download
GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
Project: cocalc-sagemath-dev-slelievre
Views: 418384#(C) 2008 Graham Ellis
################################################################
InstallGlobalFunction(FreeGResolution,
function(arg)
local
P,N,prime,
Dimension, DimensionRecord, DimRecs, FiltDimRecs,
BinGp,
Boundary,
BoundaryP,
Pair2Quad, Pair2QuadRec,
Quad2Pair,Quad2PairRec,
HtpyGen, HtpyWord,
StabGrps,
StabResls,
ResolutionFG,
Action,
AlgRed,
EltsG, G, Mult, MultRecord,
DelGen, DelWord, DelGenRec,
PseudoBoundary,FinalBoundary,
FilteredLength, FilteredDimension, FilteredDimensionRecord,
L,i,k,n,q,r,s,t ;
SetInfoLevel(InfoWarning,0);
P:=arg[1];
N:=arg[2];
if Length(arg)>2 then prime:=Gcd(arg[3],EvaluateProperty(P,"characteristic"));
else prime:=EvaluateProperty(P,"characteristic"); fi;
N:=Minimum(EvaluateProperty(P,"length"),N);
G:=P!.group;
EltsG:=P!.elts;
BoundaryP:=P!.boundary;
BinGp:=ContractibleGcomplex("SL(2,O-2)");
BinGp:=BinGp!.stabilizer(0,4);;
BinGp:=Image(RegularActionHomomorphism(BinGp));
#BinGp:=Group(ReduceGenerators(GeneratorsOfGroup(BinGp),BinGp));
#############################
ResolutionFG:=function(G,n)
local x, tmp, iso,iso1,iso2,iso3,res,Q, fn;
##Added April 2017
if prime>0 and Order(G)>1 then return ResolutionPrimePowerGroup(G,n); fi;
##
##Added Jan 2012
if IsBound(P!.resolutions) and HasName(G) then
x:=Position(P!.resolutions[2], Name(G));
if not x=fail then return P!.resolutions[1][x]; fi;
fi;
##
###
if Order(G)=infinity and IsAbelian(G) then
#This will only be correct if G is abelian of "rank" equal
#to the number of generators GAP has for G
res:=ResolutionGenericGroup(G,n);
return res;
fi;
###
iso:=RegularActionHomomorphism(G);
Q:=Image(iso);
if Order(Image(iso))=24 then
if IdGroup(Image(iso))=[24,3] then
iso1:=IsomorphismGroups(Q,BinGp);
res:=ResolutionFiniteGroup(BinGp,n);
res!.group:=G;
res!.elts:=List(res!.elts,x->
PreImagesRepresentative(iso,PreImagesRepresentative(iso1,x)));
return res;
fi;
fi;
#res:=ResolutionFiniteGroup(Q,n);
res:=ResolutionGenericGroup(Q,n);
res!.group:=G;
res!.elts:=List(res!.elts,x->PreImagesRepresentative(iso,x));
return res;
###
end;
#############################
if prime>0 then
##############################################
AlgRed:= function(ww)
local w,x,v,pos,u;
w:=StructuralCopy(ww);
v:=Collected(w);
for x in v do
if x[1][1]<0 then x[1][1]:=-x[1][1]; x[2]:=-x[2] mod prime; fi;
if x[1][2]<0 then x[1][2]:=-x[1][2]; x[2]:=-x[2] mod prime; fi;
x[2]:=x[2] mod prime;
od;
u:=[];
for x in v do
Append(u,MultiplyWord(x[2],[x[1]]));
od;
v:=Collected(u);
for x in v do
x[2]:=x[2] mod prime;
od;
u:=[];
for x in v do
Append(u,MultiplyWord(x[2],[x[1]]));
od;
return u;
end;
##############################################
else
##############################################
AlgRed:= function(ww)
local x,i,v,k,u,w;
#if Length(ww)>5000 then return ww; fi;
w:=ww;#w:=StructuralCopy(ww);
for x in w do
if x[2]<0 then x[1]:=-x[1];x[2]:=-x[2];fi;
od;
v:=Filtered(w,x->x[1]>0);
for x in w do
if x[1]<0 then
#RT:=RT-Runtime(); ##This takes neary all the computation time!!
##########################
k:=Position(v,[-x[1],x[2],x[3]]);
if (k=fail) then Add(v,x);
else
#Remove(v,k);
Unbind(v[k]);
fi;
##########################
#RT:=RT+Runtime();
fi;
od;
v:=Filtered(v,x->IsBound(x));
return v;
end;
##############################################
fi;
##############################################
if IsBound(P!.action) and not prime=2 then
Action:=P!.action;
else
Action:=function(k,j,g) return 1; end;
fi;
##############################################
MultRecord:=[];
################################################################
Mult:=function(g,h)
local pos;
if not IsBound(MultRecord[g]) then MultRecord[g]:=[]; fi;
if not IsBound(MultRecord[g][h]) then
pos:= Position(EltsG,EltsG[g]*EltsG[h]);
if pos=fail then Add(EltsG,EltsG[g]*EltsG[h]);
MultRecord[g][h]:= Length(EltsG);
else MultRecord[g][h]:= pos;
fi;
fi;
return MultRecord[g][h];
end;
################################################################
StabGrps:= List([0..Length(P)],n->
List([1..P!.dimension(n)], k->P!.stabilizer(n,k)));
StabResls:=[];
i:=N;
#if true then
#################################
for L in StabGrps do
Add(StabResls,List(L,
g->ExtendScalars(ResolutionFG(g,i),G,EltsG))
);
i:=Maximum(0,AbsInt(i-1));
od;
#################################
#else
##################################
#for L in StabGrps do
#Add(StabResls,List(L,
##g->ExtendScalars(ResolutionFiniteGroup(g,i,false,prime),G,EltsG)));
#g->ExtendScalars(ResolutionGenericGroup(g,i,false,prime),G,EltsG)));
#i:=Maximum(0,AbsInt(i-1));
#od;
##################################
#fi;
DimRecs:=List([0..N],i->[]);
###################################################################
Dimension:=function(k)
local dim,i,R;
dim:=0;
for i in [0..k] do
DimRecs[k+1][i+1]:=[];
for R in StabResls[i+1] do
dim:=dim+R!.dimension(k-i);
Add(DimRecs[k+1][i+1],dim);
od;
od;
return dim;
end;
DimensionRecord:=List([0..N],Dimension);
Dimension:=function(k);
return DimensionRecord[k+1];
end;
###################################################################
###################################################################
Quad2PairRec:=[];
for q in [0..N] do
Quad2PairRec[q+1]:=[];
for r in [1..Length(StabGrps[q+1])] do
Quad2PairRec[q+1][r]:=[];
for s in [0..N-q] do
Quad2PairRec[q+1][r][s+1]:=[];
od;od;od;
###################################################################
###################################################################
Pair2Quad:=function(k,n)
local qq,q,r,s,t;
#The n-th generator in degree k of our final resolution is actually the
#t-th generator in degree s of the resolution of the r-th stabilizer group
#of the q-th chain module of the non-free resolution. We need the
#function f(k,n)=[q,r,s,t] .
for qq in [0..N] do
if n <= DimRecs[k+1][qq+1][Length(DimRecs[k+1][qq+1])] then q:=qq; break; fi;
od;
r:=PositionProperty(DimRecs[k+1][q+1],x->(n<=x));
s:=k-q;
if r-1>0 then
t:=n-DimRecs[k+1][q+1][r-1];
else
if q>=1 then
t:=n-DimRecs[k+1][q][Length( DimRecs[k+1][q] )];;
else t:=n;
fi;
fi;
Quad2PairRec[q+1][r][s+1][t]:=[k,n];
return [q,r,s,t];
end;
Pair2QuadRec:=List([1..N+1],i->[]);
for k in [0..N] do
for n in [1..Dimension(k)] do
Pair2QuadRec[k+1][n]:=Pair2Quad(k,n);
od;
od;
##############
Pair2Quad:=function(k,n)
local a;
if n>0 then
return StructuralCopy(Pair2QuadRec[k+1][n]);
else
a:=StructuralCopy(Pair2QuadRec[k+1][-n]);
a[4]:=-a[4];
return a;
fi;
end;
##############
##############
Quad2Pair:=function(q,r,s,t)
local a,pr,pt;
if r>0 then pr:=r;pt:=t;
else
pr:=-r;pt:=-t;
fi;
if pt>0 then
return StructuralCopy(Quad2PairRec[q+1][pr][s+1][pt]);
else
a:=StructuralCopy(Quad2PairRec[q+1][pr][s+1][-pt]);
a[2]:=-a[2];
return a;
fi;
end;
##############
###################################################################
###################################################################
HtpyGen:=function(q,s,r,t,g)
local y,pr,pt;
#This applies the "vertical homotopy" to the free group generator [r,t,g]
#in "dimension" [q,s]. The output is an "r-word" in "dimension" [q,s+1].
if r>0 then pr:=r;pt:=t;
else
pr:=-r;pt:=-t;
fi;
y:=StructuralCopy(StabResls[q+1][pr]!.homotopy(s,[pt,g]));
Apply(y,x->[pr,x[1],x[2]]);
return y;
end;
###################################################################
###################################################################
HtpyWord:=function(q,s,w)
local h,z,x,y;
#This applies the "vertical homotopy" to the r-word w in "dimension"
#[q,s]. The output is an r-word in "dimension" [q,s+1].
h:=[];
for y in w do
x:=[Action(q,y[1],y[3])*y[1],y[2],y[3]];
z:=HtpyGen(q,s,x[1],x[2],x[3]);
z:=List(z,a->[Action(q,a[1],a[3])*a[1],a[2],a[3]]);
Append(h,z);
od;
return AlgRed(h);
end;
###################################################################
DelGenRec:=[];
for k in [1..N+1] do
DelGenRec[k]:=[];
for q in [1..N+1] do
DelGenRec[k][q]:=[];
for s in [1..N+1] do
DelGenRec[k][q][s]:=[];
for r in [1..P!.dimension(q-1)] do
DelGenRec[k][q][s][r]:=[];
od;
od;
od;
od;
###################################################################
DelGen:=function(k,q,s,r,t)
local y,pr,pt,i;
#For k=0,1,2 ... this is the equivariant homomorphism
#Del_k:A_{q,s} ---> A_{q-k,s+k-1} applied to a free r-generator [r,t]
#in dimension [q,s].
if r>0 then pr:=r;pt:=t;
else
pr:=-r;pt:=-t;
fi;
##############
if IsBound(DelGenRec[k+1][q+1][s+1][pr][AbsInt(pt)]) then
if pt>0 then return DelGenRec[k+1][q+1][s+1][pr][pt];
else
return List(DelGenRec[k+1][q+1][s+1][pr][-pt], a->[a[1],-a[2],a[3]]);
fi;
fi;
##############
if k=0 then
if s=0 then return [];
else
y:=List(StabResls[q+1][pr]!.boundary(s,pt),x->[Action(q,r,x[2])*x[1],x[2]]);
if pt>0 then
DelGenRec[k+1][q+1][s+1][pr][pt]:= AlgRed(List(y,x->[pr,x[1],x[2]]));
return DelGenRec[k+1][q+1][s+1][pr][pt];
else DelGenRec[k+1][q+1][s+1][pr][-pt]:=AlgRed(List(y,x->[pr,-x[1],x[2]]));
return AlgRed(List(y,x->[pr,x[1],x[2]]));
fi;
fi;
fi;
if k=1 then
if s=0 then
if q=0 then return [];
fi;
y:=BoundaryP(q,pr);
if pt>0 then
DelGenRec[k+1][q+1][s+1][pr][pt]:= AlgRed(List(y,x->[x[1],1,x[2]]));
return DelGenRec[k+1][q+1][s+1][pr][pt];
else
DelGenRec[k+1][q+1][s+1][pr][-pt]:= AlgRed(List(y,x->[x[1],1,x[2]]));
return List(y,x->[x[1],-1,x[2]]);
fi;
else
if pt>0 then
DelGenRec[k+1][q+1][s+1][pr][pt]:=
AlgRed(HtpyWord(q-1,s-1,DelWord(1,q,s-1,DelGen(0,q,s,pr,-pt)))) ;
return DelGenRec[k+1][q+1][s+1][pr][pt];
else
DelGenRec[k+1][q+1][s+1][pr][-pt]:=
AlgRed(HtpyWord(q-1,s-1,DelWord(1,q,s-1,DelGen(0,q,s,pr,pt)))) ;
return
List(DelGenRec[k+1][q+1][s+1][pr][-pt], a->[a[1],-a[2],a[3]]);
fi;
fi;
fi;
y:=[];
for i in [1..k] do
Append(y,
HtpyWord(q-k,s+k-2,DelWord(i,q-k+i,s+k-i-1,DelGen(k-i,q,s,pr,-pt)))
);
od;
y:=AlgRed(y);
if pt>0 then
DelGenRec[k+1][q+1][s+1][pr][pt]:=y;
else
DelGenRec[k+1][q+1][s+1][pr][-pt]:=List(y,a->[a[1],-a[2],a[3]]);
fi;
return y;
end;
###################################################################
###################################################################
DelWord:=function(k,q,s,w)
local y,x;
#For k=0,1,2 ... this is the equivariant homomorphism
#Del_k:A_{q,s} ---> A_{q-k,s+k-1} applied to an r-word [[r,t,g],...]
#in dimension [q,s].
y:=[];
for x in w do
Append(y,List(DelGen(k,q,s,x[1],x[2]),
a->[a[1],a[2],Mult(x[3],a[3])]));
od;
return y; #Added Jan 2013. Speeds up the calculation in some(!!) examples.
return AlgRed(y);
end;
###################################################################
###################################################################
Boundary:=function(k,n)
local q,s,r,t,x,y,z,i;
y:=Pair2Quad(k,n); q:=y[1];s:=y[3];r:=y[2];t:=y[4];
y:=[];
for i in [0..k] do
#for i in [0..1] do
if q>=i then
z:=DelGen(i,q,s,r,t);
Append(y,
List(z,x->[Quad2Pair(q-i,x[1],s+i-1,x[2])[2],x[3]]) );
else break;
fi;
od;
return AlgebraicReduction(y);
end;
###################################################################
PseudoBoundary:=[];
for n in [1..N+1] do
PseudoBoundary[n]:=[];
od;
#######################################
FinalBoundary:=function(n,k)
local pk;
pk:=AbsInt(k);
if not IsBound(PseudoBoundary[n+1][pk]) then
PseudoBoundary[n+1][pk]:= Boundary(n,pk);
fi;
if k>0 then return PseudoBoundary[n+1][k];
else return NegateWord(PseudoBoundary[n+1][pk]); fi;
end;
#######################################
################spectral sequence requirements##################
FiltDimRecs:=[];
for k in [0..N] do
FiltDimRecs[k+1]:=[];
for i in [1..Dimension(k)] do
FiltDimRecs[k+1][i]:=Pair2Quad(k,i)[1];
od;
od;
FilteredLength:=Maximum(Flat(FiltDimRecs));
##################################################
FilteredDimension:=function(r,k);
return Length(Filtered(FiltDimRecs[k+1],x->x<=r));
end;
##################################################
SetInfoLevel(InfoWarning,1);
return Objectify(HapResolution,
rec(
dimension:=Dimension,
filteredDimension:=FilteredDimension,
boundary:=FinalBoundary,
homotopy:=fail,
elts:=P!.elts,
group:=P!.group,
pseudoBoundary:=PseudoBoundary,
properties:=
[["length",N],
["filtration_length",FilteredLength],
["initial_inclusion",true],
["reduced",true],
["type","resolution"],
["characteristic",prime] ]));
end);
################################################################
################################################################
################################################################
################################################################
InstallGlobalFunction(ExtendScalars,
function(arg)
# Here H=S!.group is a subgroup of G, and EltsG is a list of the
# elements of G.
local
S,G,EltsG,
R,T,
H,EltsH,
HhomG,GmapTH,THmapG,
HhomGrec,GmapTHrec,THmapGrec,
BoundaryS,Boundary,
HomotopyS,Homotopy,
PseudoBoundary,n,k,PseudoHomotopy,FinalHomotopy,
PosG;
S:=arg[1];
G:=arg[2];
EltsG:=arg[3];
PosG:=Position;
H:=S!.group;
EltsH:=S!.elts;
BoundaryS:=S!.boundary;
HomotopyS:=S!.homotopy;
HhomGrec:=[];
#######################################
HhomG:=function(i)
local pos;
if IsBound(HhomGrec[i]) then return HhomGrec[i]; fi;
pos:= PosG(EltsG,EltsH[i]);
if pos=fail then Add(EltsG,EltsH[i]); HhomGrec[i]:=Length(EltsG);
else HhomGrec[i]:= pos; fi;
return HhomGrec[i];
end;
#######################################
PseudoBoundary:=[];
for n in [1..Length(S)+1] do
PseudoBoundary[n]:=[];
od;
#######################################
Boundary:=function(n,k)
local pk;
pk:=AbsInt(k);
if not IsBound(PseudoBoundary[n+1][pk]) then
PseudoBoundary[n+1][pk]:= List(BoundaryS(n,pk),x->[x[1],HhomG(x[2])]);
fi;
if k>0 then return PseudoBoundary[n+1][k];
else return NegateWord(PseudoBoundary[n+1][pk]); fi;
end;
#######################################
GmapTHrec:=[];
#######################################
GmapTH:=function(g) #ht=g^-1 ==> g=t^-1 h^-1
local t,h,gg,pos1,pos2;
if IsBound(GmapTHrec[g]) then return GmapTHrec[g]; fi;
gg:=EltsG[g]^-1;
#t:=CanonicalRightCosetElement(H,gg)^-1;
t:=CanonicalRightCountableCosetElement(H,gg)^-1;
#t:=CanonicalRightCosetElement(H,gg)^-1;
h:=(gg*t)^-1;
pos1:=PosG(EltsG,t);
if pos1=fail then Add(EltsG,t); pos1:=Length(EltsG);fi;
pos2:=Position(EltsH,h);
if pos2=fail then Add(EltsH,h); pos2:=Length(EltsH);fi;
GmapTHrec[g]:= [pos1,pos2];
return GmapTHrec[g];
end;
#######################################
THmapGrec:=[];
#######################################
THmapG:=function(t,h)
local pos, g;
if not IsBound(THmapGrec[t]) then THmapGrec[t]:=[]; fi;
if IsBound( THmapGrec[t][h] ) then return THmapGrec[t][h]; fi;
g:=EltsG[t]*EltsG[HhomG(h)];
pos:= PosG(EltsG,g);
if pos=fail then Add(EltsG, g);
THmapGrec[t][h]:= Length(EltsG);
else THmapGrec[t][h]:= pos; fi;
return THmapGrec[t][h];
end;
#######################################
#######################################
Homotopy:=function(n,p)
local ht,h,t,g,k,htpy;
k:=p[1];
g:=p[2];
ht:=GmapTH(g);
h:=ht[2];t:=ht[1];
htpy:=(HomotopyS(n,[k,h]));
return List( htpy,x->[x[1],THmapG(t,x[2])] );
end;
#######################################
PseudoHomotopy:=[];
for n in [1..Length(S)] do
PseudoHomotopy[n]:=[];
for k in [1..S!.dimension(n-1)] do
PseudoHomotopy[n][k]:=[];
od;
od;
#######################################
FinalHomotopy:=function(n,p)
local t,g,pt;
t:=p[1];g:=p[2];pt:=AbsInt(t);
if not IsBound(PseudoHomotopy[n+1][pt][g]) then
PseudoHomotopy[n+1][pt][g]:= Homotopy(n,[pt,g]);
fi;
if t>0 then return PseudoHomotopy[n+1][pt][g];
else return NegateWord(PseudoHomotopy[n+1][pt][g]); fi;
end;
#######################################
return Objectify(HapResolution,
rec(
dimension:=S!.dimension,
boundary:=Boundary,
homotopy:=FinalHomotopy,
elts:=EltsG,
group:=G,
properties:=S!.properties
));
end);
################################################################
################################################################
################################################################
################################################################
InstallGlobalFunction(InduceScalars,
function(S,hom)
local
G,Q,N,R,StabilizerSubgroup,
Boundary,BoundaryS,
QmapG,
EltsG, EltsQ,
PseudoBoundary, FinalBoundary,n;
G:=Source(hom);
N:=Kernel(hom);
EltsG:=Elements(G);
EltsQ:=S!.elts;
BoundaryS:=S!.boundary;
###############################################################
StabilizerSubgroup:=function(k,n);
return N;
end;
################################################################
#################################################################
QmapG:=function(q)
local pos;
pos:= Position(EltsG,PreImagesRepresentative(hom,EltsQ[q]));
if pos = fail then Add(EltsG,PreImagesRepresentative(hom,EltsQ[q]));
return Length(EltsG);
else return pos; fi;
end;
#################################################################
#################################################################
Boundary:=function(k,n);
return List(BoundaryS(k,n),x->[x[1],QmapG(x[2])]);
end;
#################################################################
PseudoBoundary:=[];
for n in [1..Length(S)+1] do
PseudoBoundary[n]:=[];
od;
#######################################
FinalBoundary:=function(n,k)
local pk;
pk:=AbsInt(k);
if not IsBound(PseudoBoundary[n+1][pk]) then
PseudoBoundary[n+1][pk]:= Boundary(n,pk);
fi;
if k>0 then return PseudoBoundary[n+1][k];
else return NegateWord(PseudoBoundary[n+1][pk]); fi;
end;
#######################################
return Objectify(HapNonFreeResolution,
rec(
dimension:=S!.dimension,
boundary:=FinalBoundary,
homotopy:=fail,
elts:=EltsG,
group:=G,
stabilizer:=StabilizerSubgroup,
properties:=
[["type","resolution"],
["length",EvaluateProperty(S,"length")],
["characteristic", EvaluateProperty(S,"characteristic")] ]));
end);
################################################################
################################################################
################################################################
################################################################
InstallGlobalFunction(CoxeterComplex,
function(arg)
local
D,N,R, A, W, WP, EltsWP, WPev,
AhomW, WhomWP, AhomWP,
ResGens,
Dimension,
StabilizerSubgroup,
Action,
StandardWord,
i, n, k,x;
D:=arg[1];
if Length(arg)>1 then N:=arg[2];
else N:=1000; fi;
###########################
if not CoxeterDiagramIsSpherical(D) then
#Print("This function is only implemented for finite Coxeter groups.\n");
#return fail;
return CoxeterComplex_alt(D,N);
fi;
###########################
R:=ResolutionArtinGroup(D,N); #I guess no one will ever try
#more than 1000 generators!
A:=R!.group;
N:=Minimum(N,Length(GeneratorsOfGroup(A)));
for n in [1..N] do
for k in [1..R!.dimension(n)] do
i:=R!.boundary(n,k);
od; od;
ResGens:=R!.resGens;
W:=CoxeterDiagramFpCoxeterGroup(D);
W:=W[1]/W[2];
AhomW:=GroupHomomorphismByImagesNC(A,W,GeneratorsOfGroup(A),GeneratorsOfGroup(W));
WhomWP:=IsomorphismPermGroup(W);
WP:=Image(WhomWP);
WPev:=EvenSubgroup(WP);
AhomWP:=GroupHomomorphismByFunction(A,WP,x->Image(WhomWP,Image(AhomW,x)));
EltsWP:=List(R!.elts,x->Image(AhomWP,x));
EltsWP:=Concatenation(
EltsWP,
Filtered(Elements(WP),x->not x in EltsWP));
###############################################################
StabilizerSubgroup:=function(n,k)
local G;
G:=List(ResGens[n+1][k], x->GeneratorsOfGroup(WP)[x]);
if Length(G)>0 then return Group(G);fi;
return Group(());
end;
###############################################################
###############################################################
# This describes how the group WP acts on the orientation.
Action:=function(k,j,g);
if
EltsWP[g] in WPev then return 1;
else return -1; fi;
end;
###############################################################
#####################################################################
Dimension:=function(n);
if n=0 then return 1; fi;
if n>Length(R) then return 0;
else return R!.dimension(n); fi;
end;
#####################################################################
#####################################################################
StandardWord:=function(k,bnd)
local w;
w:=
List(bnd,x->[x[1],
Position(EltsWP, CanonicalRightCosetElement(StabilizerSubgroup(k,AbsInt(x[1])), EltsWP[x[2]]^-1 )^-1)
]);
return AlgebraicReduction(w);
end;
#####################################################################
return Objectify(HapNonFreeResolution,
rec(
dimension:=Dimension,
boundary:=R!.boundary,
homotopy:=fail,
elts:=EltsWP,
group:=WP,
stabilizer:=StabilizerSubgroup,
action:=Action,
standardWord:=StandardWord,
properties:=
[["type","resolution"],
["length",N],
["characteristic", 0] ]));
end);
################################################################
################################################################
#####################################################################
#####################################################################
InstallGlobalFunction(CoxeterComplex_alt,
function(D,K)
local
Dimension,
Boundary,
Contraction, #not yet used
EltsG,
Vertices,
G, gensG,
W, Wgens, GhomW,
ResGens,
BoundaryCoeff,
PseudoBoundary,
BoundaryRecord,
Action, StabilizerSubgroup,
m, n, S, SD, LN;
Vertices:=CoxeterDiagramVertices(D);
G:=CoxeterDiagramMatCoxeterGroup(D);
gensG:=GeneratorsOfGroup(G);
LN:=Length(gensG[1]);
EltsG:=[];
ResGens:=[];
ResGens[1]:=[[]];
for n in [1..K] do
ResGens[n+1]:=[];
for S in Combinations(Vertices,n) do
SD:=CoxeterSubDiagram(D,S);
if CoxeterDiagramIsSpherical(SD) then AddSet(ResGens[n+1],S); fi;
od;
od;
#####################################################################
Dimension:=function(n);
if n=0 then return 1; fi;
if n>=Length(ResGens) then return 0;
else return Length(ResGens[n+1]); fi;
end;
#####################################################################
BoundaryRecord:=[];
for n in [1..K] do
BoundaryRecord[n]:=[];
for m in [1..Dimension(n)] do
BoundaryRecord[n][m]:=true;
od;
od;
#####################################################################
BoundaryCoeff:=function(S,T) #S is a set of vertices generating a
#finite Coxeter group WS. T is a
#subset of S, and WT is the corresponding
#subgroup of WS.
local SD, WS, gensWS,
WT, gensWT,
Trans,
WShomG, Ggens,
x,y;
SD:=CoxeterSubDiagram(D,S);
WS:=CoxeterDiagramFpCoxeterGroup(SD);
WS:=WS[1]/WS[2];
Ggens:=List(S,x->gensG[Position(Vertices,x)]);
gensWS:=GeneratorsOfGroup(WS);
WShomG:=GroupHomomorphismByImagesNC(WS,G,gensWS,Ggens);
gensWT:=List(T,x->gensWS[Position(S,x)]);
if Length(T)>0 then WT:=Group(gensWT);
else WT:=Group(Identity(WS)); fi;
Trans:=List(Elements(RightTransversal(WS,WT)),x->x^-1);
for x in Trans do
y:=Image(WShomG,x);
if not y in EltsG then Append(EltsG,[y]); fi;
od;
return List(Trans,x->Image(WShomG,x));
end;
#####################################################################
#####################################################################
PseudoBoundary:=function(S) #S is a subset of vertices with finite
#Coxeter group WS.
local T, bndry, a;
bndry:=[];
for T in Combinations(S,Length(S)-1) do
a:=Difference(S,T)[1];
Append(bndry,[ [T,BoundaryCoeff(S,T),Position(S,a)] ]);
od;
return bndry;
end;
#####################################################################
#####################################################################
Boundary:=function(n,kk)
local B, B1, FreeGWord, x, y, k;
#n:=AbsoluteValue(m);
if n<1 then return 0; fi;
k:=AbsoluteValue(kk);
if not BoundaryRecord[n][k]=true then
if kk>0 then return BoundaryRecord[n][k];
else return NegateWord(BoundaryRecord[n][k]);fi;
fi;
B:=PseudoBoundary(ResGens[n+1][k]);
#B1:=List(B,x->[Position(ResGens[n],x[1]),
# List(x[2],y->(-1)^(Length(y)+x[3])*Position(EltsG,y)) ]);
B1:=List(B,x->[Position(ResGens[n],x[1]),
List(x[2],y->Determinant(y)*(-1)^(x[3])*Position(EltsG,y)) ]);
FreeGWord:=[];
for x in B1 do
for y in x[2] do
Append(FreeGWord,[ [SignInt(y)*x[1],AbsoluteValue(y)] ]);
od;
od;
BoundaryRecord[n][k]:=FreeGWord;
if kk>0 then return FreeGWord;
else return NegateWord(FreeGWord); fi;
end;
#####################################################################
###############################################################
StabilizerSubgroup:=function(n,k)
local G,S;
S:=ResGens[n+1][k];
S:=List(S,i->gensG[i] ) ;
if Length(S)=0 then return Group(IdentityMat(LN)); fi;
return Group(S);
end;
###############################################################
###############################################################
# This describes how the group WP acts on the orientation.
Action:=function(n,k,g);
if n=0 then return 1; fi;
return Determinant( EltsG[g]);
end;
###############################################################
return Objectify(HapNonFreeResolution,
rec(
dimension:=Dimension,
boundary:=Boundary,
homotopy:=fail,
elts:=EltsG,
group:=G,
stabilizer:=StabilizerSubgroup,
action:=Action,
properties:=
[["length",n],
["characteristic",0],
["type","resolution"],
["reduced",true]] ));
end);
#####################################################################
#####################################################################
################################################################
################################################################
InstallGlobalFunction(ResolutionCoxeterGroup,
function(D,n)
local P,R;
###########################
if not CoxeterDiagramIsSpherical(D) then
Print("This function is only implemented for finite Coxeter groups.\n");
return fail;
fi;
###########################
P:=CoxeterComplex(D,n);
return FreeGResolution(P,n);
end);
################################################################
################################################################
################################################################
################################################################
InstallGlobalFunction(TwistedResolution,
function(R,Action)
local N, n,k,g,Boundary, BoundaryRec,Homotopy,HomotopyRec;
N:=Length(R);
##################################################
Boundary:=function(n,k)
local bnd;
bnd:=StructuralCopy(R!.boundary(n,k));
Apply(bnd,x->[Action(x[2])*x[1],x[2]]);
return bnd;
end;
##################################################
BoundaryRec:=[];
for n in [1..N] do
BoundaryRec[n]:=[];
for k in [1..R!.dimension(n)] do
BoundaryRec[n][k]:=StructuralCopy(Boundary(n,k));
od;
od;
##################################################
Boundary:=function(n,k);
if k> 0 then
return BoundaryRec[n][k];
else return
NegateWord(BoundaryRec[n][AbsInt(k)]);
fi;
end;
##################################################
##################################################
Homotopy:=function(n,x)
local htpy;
htpy:=[Action(x[2])*x[1],x[2]];
htpy:=StructuralCopy(R!.homotopy(n,htpy));
Apply(htpy,y->[Action(y[2])*y[1],y[2]]);
return htpy;
end;
##################################################
HomotopyRec:=[];
for n in [0..N-2] do
HomotopyRec[n+1]:=[];
for k in [1..R!.dimension(n)] do
HomotopyRec[n+1][k]:=[];
for g in [1..Length(R!.elts)] do
HomotopyRec[n+1][k][g]:=Homotopy(n,[k,g]);
od;od;od;
##################################################
Homotopy:=function(n,x);
if x[1]>0 then return
HomotopyRec[n+1][x[1]][x[2]];
else return
NegateWord(HomotopyRec[n+1][AbsInt(x[1])][x[2]]);
fi;
end;
##################################################
return Objectify(HapNonFreeResolution,
rec(
dimension:=R!.dimension,
boundary:=Boundary,
homotopy:=Homotopy,
elts:=R!.elts,
group:=R!.group,
properties:=
[["type","resolution"],
["length",N],
["characteristic", 0] ]));
end);
################################################################
################################################################