#(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,bool;

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;
bool:=not IsComponentObjectRep(One(G));
bool:=IsHapSL2Subgroup(G) or IsHapSL2OSubgroup(G) or IsBound(G!.bianchiInteger);
EltsG:=P!.elts;
BoundaryP:=P!.boundary;

BinGp:=ContractibleGcomplex("SL(2,O-2)_a");
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;
#x:=SmallGeneratingSet(G);
#if Length(x)>0 then G:=Group(x); fi;
##Added April 2017
#if prime>0 and Order(G)>1 and IsPGroup(G) then Print(IdGroup(G)); return ResolutionPrimePowerGroup(G,n); fi; #Something is wrong here!
if prime>0 and Order(G)>1 and SSortedList(Factors(Order(G)))=[prime] 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 IsBianchiAbelianGroup(G) and Order(G)=infinity then 
#if IsAbelian(G) and Order(G)=infinity then
res:=ResolutionAbelianBianchiSubgroup(G,n);
return res;
fi;
if IsAbelian(G) and not bool then   #NOT SURE WHY I NEED TO DO THIS
#if false then
res:=ResolutionAbelianGroup_alt(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, vv, vvv, vvvv, pos, pos2;

w:=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
##########################
#        k:=Position(v,[-x[1],x[2],x[3]]);  
#        if (k=fail) then Add(v,x); 
#        else
#        Unbind(v[k]);
#        fi;
##########################
#        fi;
#        od;
#        v:=Filtered(v,x->IsBound(x));
#        return v;
         v:=Collected(w);
         vv:=List(v,x->x[1]);
         vvv:=List(vv,x->[AbsInt(x[1]),x[2],x[3]]);
         vvv:=SSortedList(vvv);
         vvvv:=[];
         for x in vvv do
             pos:=Position(vv,x);
             pos2:=Position(vv,[-x[1],x[2],x[3]]);
             k:=0;
             if not pos=fail then k:=k+v[pos][2]; fi;
             if not pos2=fail then k:=k-v[pos2][2]; fi;
             if not k=0 then Append(vvvv,MultiplyWord(k,[ [x[1],x[2], x[3]] ]  )); fi;

         od;
         return vvvv;

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,
                pair2Quad:=Pair2Quad,
                quad2Pair:=Quad2Pair,
                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);
################################################################
################################################################





