#############################################################################
##
#W finite.gi POLENTA package Bjoern Assmann
##
## Methods for the calculation of
## constructive pc-sequences for finite matrix groups
##
#Y 2003
##
#############################################################################
##
#F POL_SuitableOrbitPoints( gens)
##
## gens are some matrices over GF(q)
## we calculate suitable orbit points for a stabilizer chain
## of <gens>, i.e. points with small orbits
##
POL_SuitableOrbitPoints := function( gens )
local MM,cs,l,i,x,fac,F,n,csR;
# calculate the module
F := FieldOfMatrixList( gens );
MM := GModuleByMats(gens, F);
# use the meataxe to calculate a decomposition series
cs := SMTX.BasesCompositionSeries(MM);
csR := Reversed( cs );
# build a basis through this series
n := Length( cs );
l := [];
for i in [1..(n-1)] do
x := BaseSteinitzVectors(csR[i],csR[i+1]).factorspace;
Append( l, x );
#l:=List([1..(n-1)],
#x->BaseSteinitzVectors(csR[x],csR[x+1]).factorspace[1]);
od;
return l ;
end;
POL_NextOrbitPoint := function( pcgs, h )
local k,p,i;
#k := Length( pcgs.suitableOrbitPoints );
#Print( "pcgs.suitableOrbitPoints", pcgs.suitableOrbitPoints, "\n" );
p := pcgs.suitableOrbitPoints[1];
i := 2;
while pcgs.oper( p, h ) = p do
p := pcgs.suitableOrbitPoints[i];
i := i+1;
od;
#Print( "chosen i is",i,"\n");
return p;
end;
POL_NextOrbitPoint2 := function( pcgs, h )
local k,p,i;
k := Length( pcgs.suitableOrbitPoints );
#Print( "pcgs.suitableOrbitPoints", pcgs.suitableOrbitPoints, "\n" );
p := pcgs.suitableOrbitPoints[k];
i := 1;
while pcgs.oper( p, h ) = p do
p := pcgs.suitableOrbitPoints[k-i];
i := i+1;
od;
#Print( "chosen i is",i,"\n");
return p;
end;
POL_NextOrbitPoint3 := function( pcgs, h )
return Remove(pcgs.suitableOrbitPoints);
end;
#############################################################################
##
#F ClosureBasePcgs_word(pcgsN, g, gens, lim)
##
## Calculates a constructive pc-sequence for <N,g>^gens
##
## Every arising group element is realized as a record
## containing the real element
## and the word information corresponding to gens
##
InstallGlobalFunction( ClosureBasePcgs_word,function( pcgsN, g, gens, lim )
local pcgsU,listU,u,c,l,i,comm,x,j,addGenerator;
if lim < 0 then
# G is not polycyclic
# Error("Group is not polycyclic !\n");
return fail;
fi;
# check if g is in N
if MemberTestByBasePcgs( pcgsN, g.groupElement ) then
return pcgsN;
fi;
addGenerator := function(g)
# add generator to the list of generators
Add( pcgsU.gens, g.groupElement );
# in wordGens we store information how to
# write the elements of gens in terms of gensOfG
Add( pcgsU.wordGens, g.word );
# as the third argument of the next function call we signal that
# g corresponds to the last element of pcgsU.gens
ExtendedBasePcgsMod( pcgsU, g.groupElement, [Length(pcgsU.gens),1] );
end;
# start extending U = <listU, pcgsN>
pcgsU := StructuralCopy( pcgsN );
addGenerator(g);
listU:=[g];
# loop over listU
while Length( listU ) >= 1 do
u := Remove( listU );
# consider all conjugates of u which are not contained in U
c := [];
for j in [1..Length( gens )] do
x := u.groupElement ^ gens[j];
if MemberTestByBasePcgs(pcgsU, x) then
# already contained in U
continue;
fi;
Add(c, rec(
groupElement := x,
word := Concatenation([[j,-1]], u.word, [[j,1]])
));
od;
# recurse, if <U,c>/N is not abelian
l := Length( pcgsN.pcref );
for i in [1..Length(c)] do
comm := POL_Comm( g, c[i] );
pcgsN := ClosureBasePcgs_word(pcgsN,comm,gens,lim-1);
if pcgsN = fail then return fail; fi;
for j in [(i+1)..Length(c)] do
comm := POL_Comm( c[j], c[i] );
pcgsN := ClosureBasePcgs_word(pcgsN,comm,gens,lim-1);
if pcgsN = fail then return fail; fi;
od;
od;
# reset U and listU
# check if pcgsN was modified
if Length( pcgsN.pcref) > l then
pcgsU := StructuralCopy(pcgsN);
for x in listU do
if not MemberTestByBasePcgs(pcgsU, x.groupElement) then
addGenerator(x);
fi;
od;
fi;
# finally add the conjugates to our list
for x in c do
Add(listU, x);
if not MemberTestByBasePcgs(pcgsU, x.groupElement) then
addGenerator(x);
fi;
od;
od;
return pcgsU;
end );
#############################################################################
##
#F POL_Comm( g, h )..................... calculates the Comm for records of
## group elements with word information
##
InstallGlobalFunction( POL_Comm , function( g, h )
local commElement, tempWord ,comm;
commElement := Comm( g.groupElement, h.groupElement );
tempWord := POL_InverseWord(g.word);
Append(tempWord,POL_InverseWord(h.word));
Append(tempWord,g.word);
Append(tempWord,h.word);
comm := rec(groupElement:=commElement,word:=tempWord);
return comm;
end );
#############################################################################
##
#F CPCS_finite_word( gensOfG , b)
##
## Returns a constructive polycyclic sequence for G if G is polycyclic
## of derived length at most b and it returns fail if G is not
## polycyclic
##
## Every generator is a record which contains in
## .groupElement the group element and in
## .word the wordinformation corresponding to the gensOfG list
## This feature is important if gensOfG arise as the image under
## the p-congruence homomorphism.
##
##
InstallGlobalFunction( CPCS_finite_word , function( gensOfG , b)
local c,f,d,pcgsOfN,x,epsilon,h,H,i,n,
suitableOrbitPoints,pcgsOfN_hilf,j,k;
Info( InfoPolenta, 5, "determining a constructive pcgs for the finite part...");
# Setup of N
f := FieldOfMatrixList( gensOfG );
d := Length( gensOfG[1] );
suitableOrbitPoints := POL_SuitableOrbitPoints( gensOfG );
pcgsOfN := rec( orbit := [], trans := [], trels := [], defns := [],
pcref := [],
acton := f^d, oper := OnRight, trivl := IsOne,
gens:= [], wordGens:=[], gensOfG:=gensOfG,
suitableOrbitPoints := suitableOrbitPoints );
c :=0;
epsilon := [];
for k in [1..Length(gensOfG)] do
epsilon[k] := rec(groupElement:=gensOfG[k],word:=[[k,1]]);
od;
# epsilon:=ShallowCopy(gensOfG);
j := 0;
while Length(epsilon) > 0 do
h := Remove(epsilon);
pcgsOfN := ClosureBasePcgs_word(pcgsOfN,h,gensOfG ,b);
if pcgsOfN = fail then return fail; fi;
od;
Info(InfoPolenta,5,"finished");
return pcgsOfN;
end );
#############################################################################
##
#F CPCS_FinitePart(gens)........... constructive pc-sequ. for image of <gens>
## under the p-congr. hom.
##
InstallGlobalFunction( CPCS_FinitePart , function(gens )
local p,d,gens_p,bound_derivedLength,pcgs_I_p;
#calculate the dimension of the vector space <gens> acting on
d := Length(gens[1][1]);
# determine an admissible prime
p := DetermineAdmissiblePrime(gens);
# calculate the gens of the group phi_p(<gens>) where phi_p is
# natural homomorphism in GL(d,p)
#gens_p := gens*One(GF(p));
gens_p := InducedByField(gens,GF(p));
# determine an upper bound for the derived length of G
# it could be sharper !
bound_derivedLength := d+2;
# determine a constructive polycyclic sequence for phi_p(<gens>)
pcgs_I_p := CPCS_finite_word(gens_p,bound_derivedLength);
return pcgs_I_p;
end );
###########################################################################
##
#F POL_InverseWord(word)
##
##
InstallGlobalFunction( POL_InverseWord , function(word)
local wordPart,tempWord,pos,exp;
tempWord := [];
for wordPart in Reversed(word) do
Add(tempWord,[wordPart[1],wordPart[2]*-1]);
od;
return tempWord;
end );
#############################################################################
##
#F ExtendedBasePcgsMod( pcgs, g, d ) . . . . . .. . . . . extend a base pcgs
##
## g normalizes <pcgs> and we compute a new pcgs for <pcgs, g>.
##
InstallGlobalFunction( ExtendedBasePcgsMod , function( pcgs, g, d )
local h, e, i, o, b, m, c, l, w, j, k;
# change in place - but unbind not updated information
Unbind(pcgs.pcgs);
Unbind(pcgs.rels);
# set up
h := g;
e := ShallowCopy( d );
i := 0;
# loop over base and divide off
while not pcgs.trivl( h ) do
i := i + 1;
#Print(" i=",i,"\n");
# take base point (if necessary, add new base point)
if i > Length( pcgs.orbit ) then
#b := SmallOrbitPoint( pcgs, g );
b := POL_NextOrbitPoint2( pcgs, h);
Add( pcgs.orbit, [b] );
Add( pcgs.trans, [] );
Add( pcgs.defns, [] );
Add( pcgs.trels, [] );
else
b := pcgs.orbit[i][1];
fi;
# compute the relative orbit length of h
m := 1;
c := pcgs.oper( b, h );
while not c in pcgs.orbit[i] do
m := m + 1;
c := pcgs.oper( c, h );
od;
# enlarge pcgs, if necessary
if m > 1 then
#Print(" enlarge basic orbit ",i," by ",m," copies \n");
Add( pcgs.trans[i], h );
Add( pcgs.defns[i], e );
Add( pcgs.trels[i], m );
EnlargeOrbit( pcgs.orbit[i], h, m, pcgs.oper );
# we save also g to know who was responsible for the entry
Add( pcgs.pcref, [i, Length(pcgs.trans[i]),g] );
fi;
# divide off
j := Position( pcgs.orbit[i], c );
if j > 1 then
w := TransWord( j, pcgs.trels[i] );
h := h^m * SubsWord( w, pcgs.trans[i] )^-1;
e := [[e,m], SubsAndInvertDefn( w, pcgs.defns[i] ) ];
else
h := h^m;
e := [e,m];
fi;
od;
end );
#############################################################################
##
#F RelativeOrdersPcgs_finite( pcgs )
##
InstallGlobalFunction( RelativeOrdersPcgs_finite , function( pcgs )
local t,g,order,i;
if IsBound( pcgs.relOrders )
then return pcgs.relOrders;
fi;
pcgs.relOrders := [];
#catch the trivial case
if Length(pcgs.gens)=0 then
return pcgs.relOrders;
fi;
g := pcgs.pcref[Length(pcgs.pcref)][3];
order := 1;
i := 1;
for t in Reversed( pcgs.pcref ) do
if t[3]=g then
order := order*pcgs.trels[t[1]][t[2]];
pcgs.relOrders[i] := order;
else
i := i+1;
order := 1;
g := t[3];
order := order*pcgs.trels[t[1]][t[2]];
pcgs.relOrders[i] := order;
fi;
od;
return pcgs.relOrders;
end );
#############################################################################
##
#F ExponentvectorPcgs_finite( pcgs, g )
##
InstallGlobalFunction( ExponentvectorPcgs_finite , function( pcgs, g )
local exp,h,index,part;
exp := [];
h := g;
for index in Reversed([1..Length(pcgs.gens)]) do
part := ExponentvectorPartPcgs( pcgs, h , index);
Add(exp,part);
h := (pcgs.gens[index]^-part)*h;
od;
if not h=h^0 then
Print("Failure in the Exponent computation !\n");
fi;
return exp;
end );
#############################################################################
##
#F ExponentvectorPartPcgs( pcgs, g , index)
##
## g = ...* pcgs.gens[index]^ExponentvectorPartPcgs * ...
##
InstallGlobalFunction( ExponentvectorPartPcgs , function( pcgs, g, index )
local h, e,part, i, o, b, m, c, l, w, j, k;
# set up
h := g;
i := 0;
e := [0,0];
# loop over base and divide off
while not pcgs.trivl( h ) do
i := i + 1;
# take base point
if i > Length( pcgs.orbit ) then
# Print(g , " is not contained in Pcgs\n");
return fail;
else
b := pcgs.orbit[i][1];
fi;
#the relative orbit length of h should be 1
m := 1;
c := pcgs.oper( b, h );
while not c in pcgs.orbit[i] do
m := m + 1;
c := pcgs.oper( c, h );
od;
if not m =1 then
# Print(g , " is not contained in Pcgs\n");
return fail;
fi;
# divide off
j := Position( pcgs.orbit[i], c );
if j > 1 then
w := TransWord( j, pcgs.trels[i] );
h := h^m * SubsWord( w, pcgs.trans[i] )^-1;
e := [[e,m], SubsAndInvertDefn( w, pcgs.defns[i] ) ];
fi;
od;
part := -ExtractIndexPart(e,index);
return part;
end );
#############################################################################
##
#F ExtractIndexPart( word, index)
##
InstallGlobalFunction( ExtractIndexPart , function(word, index)
local x;
# case: word=Integer
if word in Integers then
if word=index then
return 1;
else
return 0;
fi;
fi;
# case: word=[]
if IsEmpty(word) then
return 0;
fi;
# case: word=[something,Integer]
if Length(word) >1 then
if word[2] in Integers then
return word[2]*ExtractIndexPart(word[1],index);
fi;
fi;
# case [something,something,..]
x := ExtractIndexPart(word[1],index);
x := x+ExtractIndexPart(word{[2..Length(word)]},index);
return x;
end );
#############################################################################
##
#F POL_TestExpVector_finite( pcgs, g )
##
InstallGlobalFunction( POL_TestExpVector_finite , function( pcgs, g )
local exp,h,n,i;
exp := ExponentvectorPcgs_finite( pcgs, g );
# calculate the group element related to exp
h := pcgs.gens[1]^0;
n := Length(pcgs.gens);
for i in Reversed([1..n]) do
h := h*pcgs.gens[i]^exp[n-i+1];
od;
return g=h;
end );
#############################################################################
##
#F POL_Test_CPCS_FinitePart(gens)
##
POL_Test_CPCS_FinitePart := function( gens )
local pcgs, i, g, test;
pcgs := CPCS_FinitePart(gens);
if pcgs.gens=[] then return "trivial"; fi;
for i in [1..10] do
g := POL_RandomGroupElement( pcgs.gensOfG );
test := POL_TestExpVector_finite( pcgs, g );
if not test then
Error( "Failure in the exponent calculation in CPCS_FinitePart" );
fi;
Print(i);
od;
Print("\n");
end;
#############################################################################
##
#F POL_SetPcPresentation(pcgs)
##
## pcgs is a constructive pc-sequence, calculated
## by ConstructivePcSequenceFinitePart
## this function calculates a PcPresentation for the group described
## by pcgs
##
InstallGlobalFunction( POL_SetPcPresentation, function(pcgs)
local genList,ftl,n,ro,i,j,exp,conj,f_i,f_j,r_i,pcSeq;
# Attention: In pcgs.gens we have the pc-Sequence in inverse order
# because we built up the structure bottom up
pcSeq := StructuralCopy(Reversed(pcgs.gens));
# Setup
n := Length(pcgs.gens);
ftl := FromTheLeftCollector(n);
# calculate the relative orders
ro := RelativeOrdersPcgs_finite( pcgs );
for i in [1..n] do
SetRelativeOrder(ftl,i,ro[i]);
od;
# Set power relations
for i in [1..n] do
f_i := pcSeq[i];
r_i := ro[i];
exp := ExponentvectorPcgs_finite( pcgs, f_i^r_i );
genList := Exp2GenList(exp);
SetPower(ftl,i,genList);
od;
# Set the conjugation relations
for i in [1..n] do
for j in [1..(i-1)] do
f_i := pcSeq[i];
f_j := pcSeq[j];
conj := (f_j^-1)*f_i*f_j;
exp := ExponentvectorPcgs_finite( pcgs, conj);
genList := Exp2GenList(exp);
SetConjugate(ftl,i,j,genList);
od;
od;
UpdatePolycyclicCollector(ftl);
return ftl;
end );
#############################################################################
##
#F TestPOL_SetPcPresentation(pcgs)
##
##
TestPOL_SetPcPresentation := function(pcgs)
local ftl,relations,i;
ftl := POL_SetPcPresentation(pcgs);
relations := POL_NormalSubgroupGeneratorsOfK_p(pcgs,pcgs.gensOfG);
for i in [1..Length(relations)] do
if relations[i] <> relations[i]^0 then
Print("Error in TestPOL_SetPcPresentation\n");
fi;
od;
end;
#############################################################################
##
#E
