coxeterWythoff.working

#(C) Graham Ellis, 2005-2006

#####################################################################
InstallGlobalFunction(CoxeterWythoffComplex,
function(D,B,K)
local
	Dimension,
	Boundary,       
	Contraction,	#not yet used
	EltsG, EltsG1,	
	Vertices,
	G, gensG, Glist, G1,	#G is the Artin group of D. We treat G as a
 	GhomG1,	gensG1,		#free group. However, we output a copy G1 of
				#G with relators. 
	W, Wgens, GhomW,	#W is the Coxeter group of D
	ResGens,
	BoundaryCoeff,
	PseudoBoundary,
	BoundaryRecord,
	CoxeterDiagramInterval,
	CoxeterDiagramIsBlocking,
	CoxeterDiagramIsEssential,
	NonEssentialSets,
	EssentialSet,
	Vcomplement,
	Triv,
	AhomW,WhomWP,WP,WPev,AhomWP,EltsWP,A,StabilizerSubgroup,Action,
	EvenStabGroup,
	m, n,k,i,c,x,U, S, SD;

###########################
if not CoxeterDiagramIsSpherical(D) then
Print("This function is only implemented for finite Coxeter groups.\n");
return fail;
fi;
###########################

Vertices:=CoxeterDiagramVertices(D);

#######################
if not IsSubset(Vertices,B) then
Print("The specified vertices do not all lie in the vertex set of the Coxeter diagram. \n"); return fail; fi;
#######################



#######CREATE FUNCTIONS FOR FINDING ESSENTIAL SETS############
#######                                           ############
#######(The efficiency of these could easily be improved)#####

##############################################################
CoxeterDiagramInterval:=function(D,u,v)
#Inputs a diagram D and two vertices u,v.
#Outputs the list of vertices in some path from u to v.
local Paths, NewPaths, P, M, Vertices,i,j;

if u=v then return [u]; fi;

Vertices:=CoxeterDiagramVertices(D);
M:=CoxeterDiagramMatrix(D);

Paths:=[[u]];
NewPaths:=[];

while true do
for P in Paths do
for i in Vertices do
if M[P[Length(P)]][i]>2 and not i in P then
if i=v then return Concatenation(P,[i]);fi;
Add(NewPaths,Concatenation(P,[i])); fi;
od;
od;
Paths:=NewPaths; NewPaths:=[];
od;

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

#############################################################
CoxeterDiagramIsBlocking:=function(D,V,U1,U)
local u,v;

for u in U do
for v in V do
if Length(Intersection(
CoxeterDiagramInterval(D,u,v),
U1))=0
then return false; fi;
od;
od;

return true;
end;
#############################################################

NonEssentialSets:=[];
for i in [1..Length(Vertices)-1] do
NonEssentialSets[i]:=[];
for c in Combinations(Vertices,i+1) do
for x in c do
U:=Filtered(c,j->not j=x);
if CoxeterDiagramIsBlocking(D,B,U,c) then
Add(NonEssentialSets[i],U); fi;
od;
od;
od;

##############################################################
CoxeterDiagramIsEssential:=function(T);
if Length(T)=Length(Vertices) then return true; fi;
if Length(T)=0 then return true; fi;
if T in NonEssentialSets[Length(T)] then return false; fi;
return true;
end;
############################################################## 

##############################################################
EssentialSet:=function(U)
local u,U1;;

U1:=SSortedList(U);

for u in U do
RemoveSet(U1,u);
if not CoxeterDiagramIsBlocking(D,B,U1,U) then
AddSet(U1,u); fi;
od;

return  U1;
end;
##############################################################

##############################################################
Vcomplement:=function(S);
return Filtered(Vertices,x->not x in S);
end;
##############################################################

######ESSENTIAL SET FUNCTIONS NOW CREATED#####################
######                                   #####################
##############################################################


Glist:=CoxeterDiagramFpArtinGroup(D);
G1:=Glist[1]/Glist[2];        	#Take care for this not to cause Knuth-Bendix 
gensG1:=GeneratorsOfGroup(G1);	#to start up later on!
G:=Glist[1];
gensG:=GeneratorsOfGroup(G);
GhomG1:=GroupHomomorphismByImagesNC(G,G1,gensG,gensG1);
EltsG:=[];
EltsG1:=[];


ResGens:=[];
ResGens[1]:=[[]];
for n in [1..K] do
ResGens[n+1]:=[];
for S in Combinations(Vertices,n) do
if  CoxeterDiagramIsEssential(Vcomplement(S)) then AddSet(ResGens[n+1],S); fi;
od;
od;

#####################################################################
Dimension:=function(n);

if n=0 then return 1;
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]); 
y:=Image(GhomG1,y); 
Append(EltsG1,[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
if  CoxeterDiagramIsEssential(Vcomplement(T)) then
a:=Difference(S,T)[1];
Append(bndry,[  [T,BoundaryCoeff(S,T),Position(S,a)]  ]);
fi;
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))  ]);
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;
#####################################################################

####From here on we cut and past from CoxeterComplex and so need
#a change of notation!!
A:=G1;


for n in [1..K] do
for k in [1..Dimension(n)] do
i:=Boundary(n,k);
od; od;

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(EltsG1,x->Image(AhomWP,x));
EltsWP:=Concatenation(
EltsWP,
Filtered(Elements(WP),x->not x in EltsWP));

###############################################################
StabilizerSubgroup:=function(n,k)
local G,U;

U:=Filtered(Vertices,a->not a in ResGens[n+1][k]);
G:=List( Vcomplement(EssentialSet(U)), x->GeneratorsOfGroup(WP)[x]);
if Length(G)>0 then return Group(G);fi;
return Group(());
end;
###############################################################

###############################################################
EvenStabGroup:=function(n,k)
local G,U,V,x,y;

U:=Filtered(Vertices,a->not a in ResGens[n+1][k]);
V:=Vcomplement(EssentialSet(U));
U:=Difference(V,ResGens[n+1][k]); 
if Length(ResGens[n+1][k])>0 then 
V:=[];
for x in ResGens[n+1][k] do
for y in ResGens[n+1][k] do
Add(V,GeneratorsOfGroup(WP)[x]*GeneratorsOfGroup(WP)[y]);
od;
od;
V:=Concatenation(V,List(U,x->GeneratorsOfGroup(WP)[x]));
return Group(V);fi;

return Group(());;

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

###############################################################
# This describes how the group WP acts on the orientation.
Action:=function(n,k,g);
if n=0 then return 1; fi;
if
EltsWP[g] in WPev  then return 1;
#EltsWP[g] in EvenStabGroup(n,AbsInt(k))  then return 1;
else return -1; fi;  #THIS IS WRONG - VERY WRONG! FIX IT ASAP!
end;
###############################################################


return Objectify(HapNonFreeResolution,
	    rec(
	    dimension:=Dimension,
	    boundary:=Boundary,
	    homotopy:=fail,
	    elts:=EltsWP,
	    group:=WP,
	    stabilizer:=StabilizerSubgroup,
	    action:=Action,
	    properties:=
	    [["length",n],
	     ["characteristic",0],
	     ["type","resolution"],
	     ["reduced",true]]  ));
end);
#####################################################################