|
#############################################################################
##
## This file is part of GAP, a system for computational discrete algebra.
## This file's authors include Bettina Eick, Alexander Hulpke.
##
## Copyright of GAP belongs to its developers, whose names are too numerous
## to list here. Please refer to the COPYRIGHT file for details.
##
## SPDX-License-Identifier: GPL-2.0-or-later
##
## This file contains the methods for computing presentations for
## (permutation) groups.
##
#############################################################################
##
#M IsomorphismFpGroup( G )
##
InstallOtherMethod( IsomorphismFpGroup, "supply name", true, [IsGroup], 0,
function( G )
return IsomorphismFpGroup( G, "F" );
end );
InstallGlobalFunction( IsomorphismFpGroupByGenerators,function(arg)
local G,gens,nam;
G:=arg[1];
gens:=arg[2];
if Length(arg)>2 then
nam:=arg[3];
else
nam:="F";
fi;
if not ForAll(gens,i->i in G) or Index(G,SubgroupNC(G,gens))>1 then
Error("<gens> must be a generating set for G");
fi;
return IsomorphismFpGroupByGeneratorsNC(G,gens,nam);
end);
InstallOtherMethod(IsomorphismFpGroupByGeneratorsNC,"supply name",
IsIdenticalObj,[IsGroup,IsList],0,
function(G,gens)
return IsomorphismFpGroupByGeneratorsNC(G,gens,"F");
end);
InstallOtherMethod( IsomorphismFpGroupByCompositionSeries,
"supply name", true, [IsGroup], 0,
function( G )
return IsomorphismFpGroupByCompositionSeries( G, "F" );
end );
InstallOtherMethod( IsomorphismFpGroupByChiefSeries,
"supply name", true, [IsGroup], 0,
function( G )
return IsomorphismFpGroupByChiefSeries( G, "F" );
end );
InstallOtherMethod(IsomorphismFpGroup,"for perm groups",true,
[IsPermGroup,IsString],0,
function( G,nam )
# test frequent, special cases
if (not HasIsSymmetricGroup(G) and IsSymmetricGroup(G)) or
(not HasIsAlternatingGroup(G) and IsAlternatingGroup(G)) then
return IsomorphismFpGroup(G,nam);
fi;
return IsomorphismFpGroupByChiefSeries( G, nam );
end );
InstallOtherMethod( IsomorphismFpGroup,"for simple solvable permutation groups",
true,
[IsPermGroup and IsSimpleGroup and IsSolvableGroup,IsString],0,
function(G,str)
return IsomorphismFpGroupByPcgs( Pcgs(G), str );
end);
InstallOtherMethod( IsomorphismFpGroup,"for nonabelian simple permutation groups",
true, [IsPermGroup and IsNonabelianSimpleGroup,IsString],0,
function(G,str)
local l,iso,fp,stbc,gens;
# use the perfect groups library (as far as hand-created)
PerfGrpLoad(Size(G));
if Size(G)<10^6 and IsRecord(PERFRec) and
ValueOption(NO_PRECOMPUTED_DATA_OPTION)<>true and
not Size(G) in PERFRec.notKnown then
Info(InfoPerformance,2,"Using Perfect Groups Library");
# loop over the groups
for l in List([1..NrPerfectGroups(Size(G))],
i->PerfectGroup(IsPermGroup,Size(G),i)) do
iso:=IsomorphismGroups(G,l);
if iso<>fail then
fp:=IsomorphismFpGroup(l);
iso:=GroupHomomorphismByImagesNC(G,Range(fp),
List(MappingGeneratorsImages(fp)[1],
i->PreImagesRepresentative(iso,i)),
MappingGeneratorsImages(fp)[2]);
SetIsBijective(iso,true);
return iso;
fi;
od;
fi;
stbc:=StabChainMutable(G);
gens:=StrongGeneratorsStabChain(stbc);
iso:=IsomorphismFpGroupByGeneratorsNC( G, gens, str:chunk );
ProcessEpimorphismToNewFpGroup(iso);
return iso;
end);
#############################################################################
##
#M IsomorphismFpGroupByCompositionSeries( G, str )
##
InstallOtherMethod( IsomorphismFpGroupByCompositionSeries,
"for permutation groups", true,
[IsPermGroup, IsString], 0,
function( G, str )
local l, H, gensH, iso, F, gensF, imgsF, relatorsF, free, n, k, N, M,
hom, preiH, c, new, T, gensT, E, gensE, imgsE, relatorsE, rel,
w, t, i, j, series;
if IsSolvableGroup( G ) then
return IsomorphismFpGroupByPcgs( Pcgs(G), str );
fi;
# compute composition series
series := CompositionSeries( G );
l := Length( series );
# set up
H := series[l-1];
# if IsPrime( Size( H ) ) then
# gensH := Filtered( GeneratorsOfGroup( H ),
# x -> Order(x)=Size(H) ){[1]};
# else
# gensH := Set( GeneratorsOfGroup( H ) );
# gensH := Filtered( gensH, x -> x <> One(H) );
# fi;
IsNonabelianSimpleGroup(H); #ensure H knows to be simple, thus the call to
# `IsomorphismFpGroup' will not yield an infinite recursion.
IsNaturalAlternatingGroup(H); # We have quite often a factor A_n for
# which GAP knows better presentations. Thus this test is worth doing.
iso := IsomorphismFpGroup( H,str );
F := FreeGroupOfFpGroup( Image( iso ) );
gensF := GeneratorsOfGroup( F );
imgsF := MappingGeneratorsImages(iso)[1];
relatorsF := RelatorsOfFpGroup( Image( iso ) );
free := GroupHomomorphismByImagesNC( F, series[l-1], gensF, imgsF );
n := Length( gensF );
# loop over series upwards
for k in Reversed( [1..l-2] ) do
# get composition factor
N := series[k];
M := series[k+1];
# do not call `InParent'-- rather safe than sorry.
hom := NaturalHomomorphismByNormalSubgroupNC(N, M );
H := Image( hom );
# if IsPrime( Size( H ) ) then
# gensH := Filtered( GeneratorsOfGroup( H ),
# x -> Order(x)=Size(H) ){[1]};
# else
# gensH := Set( GeneratorsOfGroup( H ) );
# gensH := Filtered( gensH, x -> x <> One(H) );
# fi;
# compute presentation of H
IsNonabelianSimpleGroup(H);
IsNaturalAlternatingGroup(H);
new:=IsomorphismFpGroup(H,"@");
gensH:=List(GeneratorsOfGroup(Image(new)),
i->PreImagesRepresentative(new,i));
preiH := List( gensH, x -> PreImagesRepresentative( hom, x ) );
c := Length( gensH );
T := Image( new );
gensT := GeneratorsOfGroup( FreeGroupOfFpGroup( T ) );
# create new free group
E := FreeGroup( n+c, str );
gensE := GeneratorsOfGroup( E );
imgsE := Concatenation( preiH, imgsF );
relatorsE := [];
# modify presentation of H
for rel in RelatorsOfFpGroup( T ) do
w := MappedWord( rel, gensT, gensE{[1..c]} );
t := MappedWord( rel, gensT, imgsE{[1..c]} );
if not t = One( G ) then
t := PreImagesRepresentative( free, t );
t := MappedWord( t, gensF, gensE{[c+1..n+c]} );
else
t := One( E );
fi;
Add( relatorsE, w/t );
od;
# add operation of T on F
for i in [1..c] do
for j in [1..n] do
w := Comm( gensE[c+j], gensE[i] );
t := Comm( imgsE[c+j], imgsE[i] );
if not t = One( G ) then
t := PreImagesRepresentative( free, t );
t := MappedWord( t, gensF, gensE{[c+1..n+c]} );
else
t := One( E );
fi;
Add( relatorsE, w/t );
od;
od;
# append relators of F
for rel in relatorsF do
w := MappedWord( rel, gensF, gensE{[c+1..c+n]} );
Add( relatorsE, w );
od;
# iterate
F := E;
gensF := gensE;
imgsF := imgsE;
relatorsF := relatorsE;
free := GroupHomomorphismByImagesNC( F, N, gensF, imgsF );
n := n + c;
od;
# set up
F := F / relatorsF;
gensF := GeneratorsOfGroup( F );
if HasSize(G) then
SetSize(F,Size(G));
fi;
iso := GroupHomomorphismByImagesNC( G, F, imgsF, gensF );
SetIsBijective( iso, true );
SetKernelOfMultiplicativeGeneralMapping( iso, TrivialSubgroup( G ) );
ProcessEpimorphismToNewFpGroup(iso);
return iso;
end );
#############################################################################
##
#M IsomorphismFpGroupByChiefSeriesFactor( G, str, N )
##
InstallGlobalFunction(IsomorphismFpGroupByChiefSeriesFactor,
function(g,str,N)
local ser, ab, homs, gens, idx, start, pcgs, hom, f, fgens, auts, sf, orb,
tra, j, a, ad, lad, n, fg, free, rels, fp, vals, dec, still, lgens, ngens,
nrels, nvals, p, dodecomp, decomp, hogens, di, i, k, l,
m,abelianlimit,locallim,abpow,needgens,fampcgs,rad;
abelianlimit:=ValueOption("abelianlimit");
if abelianlimit=fail then
abelianlimit:=infinity;
fi;
if Size(g)=1 then
# often occurs in induction base
return
GroupHomomorphismByFunction(g,TRIVIAL_FP_GROUP,x->One(TRIVIAL_FP_GROUP),x->One(g):noassert);
elif g=N then
# often occurs in induction base
return GroupHomomorphismByImagesNC(g,TRIVIAL_FP_GROUP,GeneratorsOfGroup(g),
List(GeneratorsOfGroup(g),x->One(TRIVIAL_FP_GROUP)):noassert);
fi;
if ValueOption("rewrite")=true then
# try to go through radical (image) and pick generators split in radical factor
rad:=ClosureGroup(SolvableRadical(g),N);
ser:=[];
gens:=[];
if Size(rad)<Size(g) then
hom:=NaturalHomomorphismByNormalSubgroupNC(g,rad);
f:=Image(hom);
ser:=ShallowCopy(DirectFactorsFittingFreeSocle(f));
gens:=Concatenation(List(ser,SmallGeneratingSet));
j:=SubgroupNC(f,gens);
for i in GeneratorsOfGroup(f) do
if not i in j then
Add(gens,i);
j:=ClosureSubgroupNC(j,i);
fi;
od;
# build series
for i in [Length(ser)-1,Length(ser)-2..1] do
ser[i]:=ClosureGroup(ser[i+1],ser[i]);
od;
if Size(ser[1])<Size(f) then
ser:=ChiefSeriesThrough(f,ser);
gens:=Union(gens,Union(List(ser,SmallGeneratingSet)));
fi;
if f<>g then
gens:=List(gens,x->PreImagesRepresentative(hom,x));
ser:=List(ser,x->PreImage(hom,x));
fi;
# change generators to make split
ser:=List(ser,x->ClosureGroup(rad,Filtered(gens,y->y in x)));
else
rad:=g;
fi;
if Length(ser)=0 or Size(Last(ser))>Size(rad) then Add(ser,rad);fi;
if Size(rad)>1 then
if HasChiefSeries(g) and N in ChiefSeries(g) and rad in ChiefSeries(g) then
f:=Filtered(ChiefSeries(g),x->IsSubset(rad,x));
elif IsTrivial(N) then
if rad=g then
f:=ChiefSeries(g);
else
f:=ChiefSeriesUnderAction(g,rad);
fi;
else
f:=ChiefSeriesThrough(g,[rad,N]);
fi;
Append(ser,Filtered(f,x->Size(x)<Size(rad)));
fi;
elif IsTrivial(N) then
ser:=ChiefSeries(g);
else
if HasChiefSeries(g) and N in ChiefSeries(g) then
ser:=ChiefSeries(g);
else
ser:=ChiefSeriesThrough(g,[N]);
fi;
fi;
if Size(N)>1 then
ser:=Filtered(ser,i->IsSubset(i,N));
fi;
if IsSolvableGroup(g) then
fampcgs:=SpecialPcgs(g);
else
fampcgs:=fail;
fi;
ab:=[];
homs:=[];
gens:=[];
idx:=[];
abpow:=[]; # store powers for large order abelian
for i in [2..Length(ser)] do
start:=Length(gens)+1;
if HasAbelianFactorGroup(ser[i-1],ser[i]) then
ab[i-1]:=true;
if fampcgs<>fail then
pcgs:=CanonicalPcgs(InducedPcgs(fampcgs,ser[i-1])) mod
CanonicalPcgs(InducedPcgs(fampcgs,ser[i]));
else
pcgs:=ModuloPcgs(ser[i-1],ser[i]);
fi;
homs[i-1]:=pcgs;
Append(gens,pcgs);
f:=pcgs;
j:=RelativeOrders(pcgs)[1];
abpow[i-1]:=[];
if abelianlimit<>infinity then
# split up evenly
k:=LogInt(j-1,abelianlimit)+1; # ensure rounded up
locallim:=RootInt(j-1,k)+1; # ensure rounded up
while j>locallim do
k:=Minimum(locallim,RootInt(j,2));
Add(abpow[i-1],k);
f:=List(f,x->x^k);
Append(gens,f);
j:=QuoInt(j,k);
od;
fi;
else
ab[i-1]:=false;
hom:=NaturalHomomorphismByNormalSubgroup(ser[i-1],ser[i]:noassert);
IsOne(hom);
f:=Image(hom);
# knowing simplicity makes it easy to test whether a map is faithful
if IsNonabelianSimpleGroup(f) then
if DataAboutSimpleGroup(f).idSimple.series="A" and
not IsNaturalAlternatingGroup(f) then
# force natural alternating
hom:=hom*IsomorphismGroups(f,
AlternatingGroup(DataAboutSimpleGroup(f).idSimple.parameter));
elif IsPermGroup(f) and
NrMovedPoints(f)>SufficientlySmallDegreeSimpleGroupOrder(Size(f)) then
hom:=hom*SmallerDegreePermutationRepresentation(f:cheap);
fi;
elif IsPermGroup(f) then
hom:=hom*SmallerDegreePermutationRepresentation(f:cheap);
fi;
# the range is elementary. Use this for the fp group isomorphism
f:=Image(hom);
# calculate automorphisms of f induced by G
fgens:=GeneratorsOfGroup(f);
auts:=List(GeneratorsOfGroup(g),i->
GroupHomomorphismByImagesNC(f,f,fgens,
List(fgens,j->Image(hom,PreImagesRepresentative(hom,j)^i)):noassert));
for j in auts do
SetIsBijective(j,true);
od;
# get the minimal normal subgroups, together with isomorphisms
sf:=CompositionSeries(f);
sf:=sf[Length(sf)-1];
orb:=[sf];
tra:=[IdentityMapping(f)];
j:=1;
while j<=Length(orb) do
for k in auts do
a:=Image(k,orb[j]);
if not a in orb then
Add(orb,a);
Add(tra,tra[j]*k);
fi;
od;
j:=j+1;
od;
# we know sf is simple
SetIsNonabelianSimpleGroup(sf,true);
IsNaturalAlternatingGroup(sf);
if ValueOption("rewrite")=true then
a:=IsomorphismFpGroupForRewriting(sf:noassert);
else
a:=IsomorphismFpGroup(sf:noassert);
fi;
ad:=List(GeneratorsOfGroup(Range(a)),i->PreImagesRepresentative(a,i));
lad:=Length(ad);
n:=Length(orb);
if n=1 and ValueOption("rewrite")=true then
fgens:=ad;
else
if ValueOption("rewrite")=true then
Info(InfoPerformance,1,
"Rewriting system preservation for direct product not yet written");
fi;
fg:=FreeGroup(Length(ad)*n,"@");
free:=GeneratorsOfGroup(fg);
rels:=[];
fgens:=[];
for j in [1..n] do
Append(fgens,List(ad,x->Image(tra[j],x)));
# translate relators
for k in RelatorsOfFpGroup(Range(a)) do
Add(rels,MappedWord(k,FreeGeneratorsOfFpGroup(Range(a)),
free{[(j-1)*lad+1..j*lad]}));
od;
# commutators with older gens
for k in [j+1..n] do
for l in [1..Length(ad)] do
for m in [1..Length(ad)] do
Add(rels,Comm(free[(k-1)*lad+l],free[(j-1)*lad+m]));
od;
od;
od;
od;
fp:=fg/rels;
a:=GroupHomomorphismByImagesNC(f,fp,fgens,GeneratorsOfGroup(fp):noassert);
fi;
Append(gens,List(fgens,i->PreImagesRepresentative(hom,i)));
# here we really want a composed homomorphism, to avoid extra work for
# a new stabilizer chain
if not IsOne(hom) then
hom:=CompositionMapping2General(a,hom);
else
hom:=a;
fi;
homs[i-1]:=hom;
fi;
Add(idx,[start..Length(gens)]);
od;
f:=FreeGroup(Length(gens),str);
free:=GeneratorsOfGroup(f);
rels:=[];
vals:=[];
dec:=[];
for i in [2..Length(ser)] do
still:=i<Length(ser);
lgens:=gens{idx[i-1]};
ngens:=free{idx[i-1]}; # new generators on this level
nrels:=[];
nvals:=[];
if ab[i-1] then
pcgs:=homs[i-1];
needgens:=Length(pcgs);
p:=RelativeOrders(pcgs)[1];
# define function in function to preserve local variables
dodecomp:=function(ngens,pcgs,abpow)
local l;
l:=Length(pcgs);
return function(elm)
local e,i,j,q;
e:=ShallowCopy(ExponentsOfPcElement(pcgs,elm));
for i in [1..Length(abpow)] do
for j in [1..l] do
# reduce entry so far
q:=QuotientRemainder(e[l*(i-1)+j],abpow[i]);
e[l*(i-1)+j]:=q[2];
e[l*i+j]:=q[1];
od;
od;
return LinearCombinationPcgs(ngens,e);
end;
end;
decomp:=dodecomp(ngens,pcgs,abpow[i-1]);
for j in [1..Length(pcgs)] do
Add(nrels,ngens[j]^p);
if still then
Add(nvals,pcgs[j]^p);
fi;
for k in [1..j-1] do
Add(nrels,Comm(ngens[j],ngens[k]));
if still then
Add(nvals,Comm(pcgs[j],pcgs[k]));
fi;
od;
od;
# generator power relations
if Length(abpow[i-1])>0 then
for k in [1..Length(abpow[i-1])] do
for j in [1..Length(pcgs)] do
Add(nrels,ngens[Length(pcgs)*(k-1)+j]^abpow[i-1][k]
/ngens[Length(pcgs)*k+j]);
if still then
Add(nvals,One(pcgs[1])); # new generator is just shorthand for
# power, so no tail to consider
fi;
od;
od;
fi;
else
hom:=homs[i-1];
hogens:=FreeGeneratorsOfFpGroup(Range(hom));
needgens:=Length(hogens);
dodecomp:=function(ngens,hogens,hom)
return elm->
MappedWord(UnderlyingElement(Image(hom,elm)),
hogens,ngens);
end;
decomp:=dodecomp(ngens,hogens,hom);
for j in RelatorsOfFpGroup(Range(hom)) do
a:=MappedWord(j,hogens,ngens);
Add(nrels,a);
if still then
Add(nvals,MappedWord(j,hogens,lgens));
fi;
od;
fi;
Add(dec,decomp);
# change relators by cofactors
for j in [1..Length(rels)] do
a:=decomp(vals[j]);
rels[j]:=rels[j]/a;
if still then
vals[j]:=vals[j]/MappedWord(a,ngens,lgens);
fi;
od;
# action relators
for j in [1..idx[i-1][1]-1] do
for k in [1..needgens] do
a:=lgens[k]^gens[j];
ad:=decomp(a);
Add(rels,ngens[k]^free[j]/ad);
if still then
Add(vals,a/MappedWord(ad,ngens,lgens));
fi;
od;
od;
# new level relators
Append(rels,nrels);
Append(vals,nvals);
od;
Assert(1,ForAll(rels,i->MappedWord(i,GeneratorsOfGroup(f),gens) in N));
fp:=f/rels;
di:=rec(gens:=gens,fp:=fp,idx:=idx,dec:=dec,source:=g,homs:=homs,
abpow:=abpow);
if IsTrivial(N) then
hom:=GroupHomomorphismByImagesNC(g,fp,gens,GeneratorsOfGroup(fp):noassert);
SetIsBijective(hom,true);
else
hom:=GroupHomomorphismByImagesNC(g,fp,
Concatenation(gens,GeneratorsOfGroup(N)),
Concatenation(GeneratorsOfGroup(fp),
List(GeneratorsOfGroup(N),i->One(fp))):noassert);
SetIsSurjective(hom,true);
SetKernelOfMultiplicativeGeneralMapping(hom,N);
fi;
hom!.decompinfo:=MakeImmutable(di);
SetIsWordDecompHomomorphism(hom,true);
ProcessEpimorphismToNewFpGroup(hom);
return hom;
end);
#############################################################################
##
#M IsomorphismFpGroupByChiefSeries( G, str )
##
InstallMethod( IsomorphismFpGroupByChiefSeries,"grp",true,
[IsGroup,IsString], 0,
function(g,str)
return IsomorphismFpGroupByChiefSeriesFactor(g,str,TrivialSubgroup(g));
end);
BindGlobal("DecompElmHomChiefSer",function(di,elm)
local f, w, a, i;
f:=FreeGroupOfFpGroup(di.fp);
w:=One(f);
for i in di.dec do
a:=i(elm);
w:=a*w;
elm:=elm/MappedWord(a,GeneratorsOfGroup(f),di.gens);
od;
return ElementOfFpGroup(ElementsFamily(FamilyObj(di.fp)),w);
end);
InstallMethod(ImagesRepresentative,"word decomp hom",FamSourceEqFamElm,
[IsGroupGeneralMappingByImages and IsWordDecompHomomorphism,
IsMultiplicativeElementWithInverse],0,
function(hom,elm)
return DecompElmHomChiefSer(hom!.decompinfo,elm);
end);
InstallGlobalFunction(LiftFactorFpHom,
function(hom,G,N,mnsf)
local fpq, qgens, qreps, fpqg, rels, pcgs, p, f, qimg, idx, nimg, decomp,
ngen, fp, hom2, di, source, dih, dec, i, j;
fpq:=Range(hom);
qgens:=GeneratorsOfGroup(fpq);
qreps:=List(qgens,i->PreImagesRepresentative(hom,i));
fpqg:=FreeGeneratorsOfFpGroup(fpq);
rels:=[];
if IsModuloPcgs(mnsf) then
pcgs:=mnsf;
p:=RelativeOrders(pcgs)[1];
f:=FreeGroup(Length(fpqg)+Length(pcgs));
qimg:=GeneratorsOfGroup(f){[1..Length(fpqg)]};
idx:=[Length(fpqg)+1..Length(fpqg)+Length(pcgs)];
nimg:=GeneratorsOfGroup(f){idx};
decomp:=function(elm)
return LinearCombinationPcgs(nimg,ExponentsOfPcElement(pcgs,elm));
end;
# n-relators
for i in [1..Length(pcgs)] do
Add(rels,nimg[i]^p);
for j in [1..i-1] do
Add(rels,Comm(nimg[i],nimg[j]));
od;
od;
elif IsRecord(mnsf) then
# mnsf is record with components:
# pcgs: generator list for pcgs
# p: prime
# decomp: Exponents for element of pcgs
pcgs:=mnsf.pcgs;
p:=mnsf.prime;
f:=FreeGroup(Length(fpqg)+Length(pcgs));
qimg:=GeneratorsOfGroup(f){[1..Length(fpqg)]};
idx:=[Length(fpqg)+1..Length(fpqg)+Length(pcgs)];
nimg:=GeneratorsOfGroup(f){idx};
decomp:=function(elm)
local coeff;
coeff:=mnsf.decomp(elm);
if LinearCombinationPcgs(pcgs,coeff)<>elm then
Error("decomperror");
fi;
return LinearCombinationPcgs(nimg,mnsf.decomp(elm));
end;
# n-relators
for i in [1..Length(pcgs)] do
Add(rels,nimg[i]^p);
for j in [1..i-1] do
Add(rels,Comm(nimg[i],nimg[j]));
od;
od;
else
# nonabelian
p:=Range(mnsf);
ngen:=FreeGeneratorsOfFpGroup(p);
# This is not really a pcgs, but treated as layer generators the same
# way, thus use the same variable name
pcgs:=List(GeneratorsOfGroup(p),i->PreImagesRepresentative(mnsf,i));
f:=FreeGroup(Length(fpqg)+Length(pcgs));
qimg:=GeneratorsOfGroup(f){[1..Length(fpqg)]};
idx:=[Length(fpqg)+1..Length(fpqg)+Length(pcgs)];
nimg:=GeneratorsOfGroup(f){idx};
decomp:=function(elm)
return MappedWord(UnderlyingElement(Image(mnsf,elm)),ngen,nimg);
end;
for i in RelatorsOfFpGroup(p) do
Add(rels,MappedWord(i,ngen,nimg));
od;
fi;
# action on n
for i in [1..Length(pcgs)] do
for j in [1..Length(qgens)] do
Add(rels,nimg[i]^qimg[j]/
decomp(pcgs[i]^qreps[j]));
od;
od;
# lift old relators with cofactors
for i in RelatorsOfFpGroup(fpq) do
Add(rels,MappedWord(i,fpqg,qimg)/decomp(MappedWord(i,fpqg,qreps)));
od;
fp:=f/rels;
if HasGeneratorsOfGroup(N) then
di:=GeneratorsOfGroup(N);
else
di:=[];
fi;
hom2:=GroupHomomorphismByImagesNC(G,fp,
Concatenation(Concatenation(qreps,pcgs),di),
Concatenation(GeneratorsOfGroup(fp),
List(di,x->One(fp))):noassert);
# build decompositioninfo
di:=rec(gens:=Concatenation(qreps,pcgs),fp:=fp,source:=G);
if IsBound(hom!.decompinfo) then
dih:=hom!.decompinfo;
if dih.source=G then
di.idx:=Concatenation(dih.idx,[idx]);
dec:=[];
for i in dih.dec do
Add(dec,elm->MappedWord(i(elm),fpqg,qimg));
od;
Add(dec,decomp);
di.dec:=dec;
fi;
fi;
if not IsBound(di.dec) then
di.idx:=[[1..Length(fpqg)],idx];
di.dec:=[elm->MappedWord(Image(hom,elm),fpqg,qimg),decomp];
fi;
hom2!.decompinfo:=MakeImmutable(di);
SetIsWordDecompHomomorphism(hom2,true);
SetIsSurjective(hom2,true);
if N<>false then
SetKernelOfMultiplicativeGeneralMapping(hom2,N);
fi;
return hom2;
end);
InstallGlobalFunction(ComplementFactorFpHom,
function(h,m,n,k,ggens,cgens)
local di, hom;
if IsBound(h!.decompinfo) then
di:=ShallowCopy(h!.decompinfo);
if di.gens=ggens or cgens=ggens then
di.gens:=cgens;
di.source:=k;
# this homomorphism is just to store decomposition information and is
# not declared total, so an assertion test will fail
hom:=GroupHomomorphismByImagesNC(k,di.fp,cgens,GeneratorsOfGroup(di.fp):noassert);
hom!.decompinfo:=MakeImmutable(di);
if HasIsSurjective(h) and IsSurjective(h)
and HasKernelOfMultiplicativeGeneralMapping(h)
and m=KernelOfMultiplicativeGeneralMapping(h) then
SetIsSurjective(hom,true);
SetKernelOfMultiplicativeGeneralMapping(hom,n);
fi;
SetIsWordDecompHomomorphism(hom,true);
return hom;
fi;
fi;
if ggens=MappingGeneratorsImages(h)[1] then
# can we simply translate a map on generators?
hom:=GroupHomomorphismByImagesNC(k,Range(h),
Concatenation(GeneratorsOfGroup(n),cgens),
Concatenation(List(GeneratorsOfGroup(n),i->One(Range(h))),
MappingGeneratorsImages(h)[2]));
return hom;
fi;
if IsBound(h!.decompinfo) then
Error("do not know yet how to lift to complement");
fi;
hom:=GroupHomomorphismByImagesNC(k,Range(h),
Concatenation(GeneratorsOfGroup(n),cgens),
Concatenation(List(GeneratorsOfGroup(n),i->One(Range(h))),
List(ggens,i->Image(h,i))));
return hom;
end);
#############################################################################
##
#M IsomorphismFpGroupByGeneratorsNC( G, gens, str )
##
InstallOtherMethod( IsomorphismFpGroupByGeneratorsNC, "for perm groups",
IsFamFamX,[IsPermGroup, IsList, IsString], 0,
function( G, gens, str )
local F, gensF, gensR, gensS, hom, info, iso, method, ngens, R, reg, rel,
relators, S;
# check for trivial cases
ngens := Length( gens );
if ngens = 0 then
S := FreeGroup( 0 );
elif ngens = 1 then
F := FreeGroup( 1 );
gensF := GeneratorsOfGroup( F );
relators := [ gensF[1]^Size( G ) ];
S := F/relators;
# check options
else
F := FreeGroup( ngens, str );
gensF := GeneratorsOfGroup( F );
method := ValueOption( "method" );
if not IsString( method ) and IsList( method ) and
Length( method ) = 2 and method[1] = "regular" then
if not IsInt( method[2] ) then
Info( InfoFpGroup + InfoWarning, 1, "Warning: function ",
"IsomorphismFpGroupByGeneratorsNC encountered an" );
Info( InfoFpGroup + InfoWarning, 1, " non-integer bound ",
"for method \"regular\"; the option has been ignored" );
elif Size( G ) <= method[2] then
method := "regular";
fi;
fi;
if method = "fast" then
# use the old method
hom := GroupHomomorphismByImagesNC( G, F, gens, gensF );
relators := CoKernelGensPermHom( hom );
elif method = "regular" and not IsRegular( G ) then
# construct a regular permutation representation of G and then
# apply the default method to it
reg := RegularActionHomomorphism( G );
R := Image( reg );
gensR := List( gens, gen -> gen^reg );
hom := GroupHomomorphismByImagesNC( R, F, gensR, gensF );
relators := RelatorsPermGroupHom( hom, gensR );
else
# apply the default method to G
hom := GroupHomomorphismByImagesNC( G, F, gens, gensF );
relators := RelatorsPermGroupHom( hom, gens );
fi;
S := F/relators;
fi;
gensS := GeneratorsOfGroup( S );
iso := GroupHomomorphismByImagesNC( G, S, gens, gensS );
if HasSize(G) then
SetSize(S,Size(G));
fi;
SetIsSurjective( iso, true );
SetIsInjective( iso, true );
SetKernelOfMultiplicativeGeneralMapping( iso, TrivialSubgroup( G ));
info := ValueOption( "infolevel" );
if info <> 2 then
info := 1;
fi;
if ngens = 0 then
Info( InfoFpGroup, info, "the image fp group is trivial" );
else
Info( InfoFpGroup, info, "the image group has ", ngens, " gens and ",
Length( relators ), " rels of total length ",
Sum( List( relators, rel -> Length( rel ) ) ) );
fi;
ProcessEpimorphismToNewFpGroup(iso);
return iso;
end );
#############################################################################
##
#M IsomorphismFpGroupByGeneratorsNC( G, gens, str )
##
InstallMethod( IsomorphismFpGroupByGeneratorsNC, "via cokernel", IsFamFamX,
[IsGroup, IsList, IsString], 0,
function( G, gens, str )
local F, hom, rels, H, gensH, iso;
F := FreeGroup( Length(gens), str );
hom := GroupGeneralMappingByImagesNC( G, F, gens, GeneratorsOfGroup(F) );
rels := GeneratorsOfGroup( CoKernelOfMultiplicativeGeneralMapping( hom ) );
H := F /rels;
gensH := GeneratorsOfGroup( H );
iso := GroupHomomorphismByImagesNC( G, H, gens, gensH );
if HasSize(G) then
SetSize(H,Size(G));
fi;
SetIsBijective( iso, true );
SetKernelOfMultiplicativeGeneralMapping( iso, TrivialSubgroup(G) );
ProcessEpimorphismToNewFpGroup(iso);
return iso;
end );
InstallMethod( IsomorphismFpGroupByGeneratorsNC,
"for trivial group",
[ IsGroup, IsList and IsEmpty, IsString ],
function( G, emptygens, name )
local hom;
if not IsTrivial( G ) then
Error( "<emptygens> does not generate <G>" );
fi;
hom:= GroupHomomorphismByImagesNC( G, FreeGroup( 0 ), [], [] );
SetIsBijective( hom, true );
return hom;
end );
#############################################################################
##
#M IsomorphismFpGroupBySubnormalSeries( G, series, str )
##
InstallMethod( IsomorphismFpGroupBySubnormalSeries,
"for groups",
true,
[IsPermGroup, IsList, IsString],
0,
function( G, series, str )
local l, H, gensH, iso, F, gensF, imgsF, relatorsF, free, n, k, N, M,
hom, preiH, c, new, T, gensT, E, gensE, imgsE, relatorsE, rel,
w, t, i, j,known;
known:=ValueOption("knownfactor");
# set up with smallest subgroup of series
l := Length( series );
H := series[l-1];
gensH := Set( GeneratorsOfGroup( H ) );
gensH := Filtered( gensH, x -> x <> One(H) );
iso := IsomorphismFpGroupByGeneratorsNC( H, gensH, str );
F := FreeGroupOfFpGroup( Image( iso ) );
gensF := GeneratorsOfGroup( F );
imgsF := MappingGeneratorsImages(iso)[1];
relatorsF := RelatorsOfFpGroup( Image( iso ) );
free := GroupHomomorphismByImagesNC( F, series[l-1], gensF, imgsF );
n := Length( gensF );
# loop over series upwards
for k in Reversed( [1..l-2] ) do
N := series[k];
M := series[k+1];
if known<>fail and M=KernelOfMultiplicativeGeneralMapping(known) then
hom:=known;
else
# get composition factor
hom := NaturalHomomorphismByNormalSubgroupNC( N, M );
fi;
H := Image( hom );
gensH := GeneratorsOfGroup( H );
gensH := Filtered( gensH, x -> x <> One(H) );
preiH := List( gensH, x -> PreImagesRepresentative( hom, x ) );
c := Length( gensH );
# compute presentation of H
if IsFpGroup(H) then
new:=IdentityMapping(H);
else
new := IsomorphismFpGroupByGeneratorsNC( H, gensH, "g" );
fi;
T := Image( new );
gensT := GeneratorsOfGroup( FreeGroupOfFpGroup( T ) );
# create new free group
E := FreeGroup( n+c, str );
gensE := GeneratorsOfGroup( E );
imgsE := Concatenation( preiH, imgsF );
relatorsE := [];
# modify presentation of H
for rel in RelatorsOfFpGroup( T ) do
w := MappedWord( rel, gensT, gensE{[1..c]} );
t := MappedWord( rel, gensT, imgsE{[1..c]} );
if not t = One( G ) then
t := PreImagesRepresentative( free, t );
t := MappedWord( t, gensF, gensE{[c+1..n+c]} );
else
t := One( E );
fi;
Add( relatorsE, w/t );
od;
# add operation of T on F
for i in [1..c] do
for j in [1..n] do
w := Comm( gensE[c+j], gensE[i] );
t := Comm( imgsE[c+j], imgsE[i] );
if not t = One( G ) then
t := PreImagesRepresentative( free, t );
t := MappedWord( t, gensF, gensE{[c+1..n+c]} );
else
t := One( E );
fi;
Add( relatorsE, w/t );
od;
od;
# append relators of F
for rel in relatorsF do
w := MappedWord( rel, gensF, gensE{[c+1..c+n]} );
Add( relatorsE, w );
od;
# iterate
F := E;
gensF := gensE;
imgsF := imgsE;
relatorsF := relatorsE;
free := GroupHomomorphismByImagesNC( F, N, gensF, imgsF );
n := n + c;
od;
# set up
F := F / relatorsF;
gensF := GeneratorsOfGroup( F );
if HasSize(G) then
SetSize(F,Size(G));
fi;
iso := GroupHomomorphismByImagesNC( G, F, imgsF, gensF );
SetIsBijective( iso, true );
SetKernelOfMultiplicativeGeneralMapping( iso, TrivialSubgroup( G ) );
ProcessEpimorphismToNewFpGroup(iso);
return iso;
end);
InstallOtherMethod( IsomorphismFpGroupBySubnormalSeries, "for groups", true,
[IsPermGroup, IsList], 0,
function( G, series )
return IsomorphismFpGroupBySubnormalSeries( G, series, "F" );
end);
InstallOtherMethod(IsomorphismFpGroupForRewriting,
"generic, deal with large element orders", true,
[IsGroup],0,
function(G)
local hom;
IsSimpleGroup(G);
hom:=IsomorphismFpGroup(G:abelianlimit:=10);
return hom;
end);
InstallGlobalFunction(MakeFpGroupToMonoidHomType1,function(fp,m)
local fam,mfam,fpfam,mfpfam,hom;
fam:=FamilyObj(UnderlyingElement(One(fp)));
mfam:=FamilyObj(UnderlyingElement(One(m)));
fpfam:=FamilyObj(One(fp));
mfpfam:=FamilyObj(One(m));
hom:=MagmaIsomorphismByFunctionsNC(fp,m,
function(w)
local l,i;
l:=[];
for i in LetterRepAssocWord(UnderlyingElement(w)) do
if i>0 then Add(l,2*i-1);
else Add(l,-2*i);fi;
od;
return ElementOfFpMonoid(mfpfam,AssocWordByLetterRep(mfam,l));
end,
function(w)
local g,i,x;
g:=[];
for i in LetterRepAssocWord(UnderlyingElement(w)) do
if IsOddInt(i) then x:=(i+1)/2;
else x:=-i/2;fi;
# word must be freely cancelled
if Length(g)>0 and x=-Last(g) then
Remove(g);
else Add(g,x); fi;
od;
return ElementOfFpGroup(fpfam,AssocWordByLetterRep(fam,g));
end);
# type 0 is inverses first
hom!.type:=1;
if not HasIsomorphismFpMonoid(fp) then
SetIsomorphismFpMonoid(fp,hom);
fi;
return hom;
end);
# return isomorphism G-fp and fp->mon, such that presentation of monoid is
# confluent (wrt wreath order). Returns record with fphom,monhom,ordering
InstallMethod(ConfluentMonoidPresentationForGroup,"generic",
[IsGroup and IsFinite],
function(G)
local iso,fp,dec,homs,mos,i,j,ffp,imo,m,k,gens,fm,mgens,rules,
loff,off,monreps,left,right,fmgens,r,diff,monreal,nums,reduce,hom,dept,
lode,lrules,rulet,addrule;
IsSimpleGroup(G);
if IsSymmetricGroup(G) then
i:=SymmetricGroup(SymmetricDegree(G));
iso:=CheapIsomSymAlt(G,i)*IsomorphismFpGroup(i);
fp:=Range(iso);
hom:=IsomorphismFpMonoid(fp);
m:=Range(hom);
fm:=FreeMonoidOfFpMonoid(m);
k:=KnuthBendixRewritingSystem(m);
MakeConfluent(k);
rules:=Rules(k);
dept:=fail;
else
iso:=IsomorphismFpGroupByChiefSeries(G:rewrite);
fp:=Range(iso);
gens:=GeneratorsOfGroup(fp);
dec:=iso!.decompinfo;
fmgens:=[];
mgens:=[];
for i in gens do
Add(fmgens,i);
Add(fmgens,i^-1);
Add(mgens,String(i));
Add(mgens,String(i^-1));
od;
nums:=List(fmgens,x->LetterRepAssocWord(UnderlyingElement(x))[1]);
fm:=FreeMonoid(mgens);
mgens:=GeneratorsOfMonoid(fm);
rules:=[];
lrules:=[];
rulet:=List(mgens,x->[]); # rules involving a particular letter
addrule:=function(rule)
local i,p;
Add(rules,rule);
rule:=List(rule,LetterRepAssocWord);
Add(lrules,rule);
p:=Length(lrules);
for i in Set(rule[1]) do
AddSet(rulet[i],p);
od;
end;
reduce:=function(w)
local red,i,p,pool,wn;
w:=LetterRepAssocWord(w);
repeat
i:=1;
pool:=Union(rulet{Set(w)});
red:=false;
while i<=Length(pool) and red=false do
p:=fail;
if Length(w)>=Length(lrules[pool[i]][1]) then
p:=PositionSublist(w,lrules[pool[i]][1]);
fi;
if p<>fail then
wn:=Concatenation(w{[1..p-1]},lrules[pool[i]][2],
w{[p+Length(lrules[pool[i]][1])..Length(w)]});
#if Length(wn)>Length(w) then Error("HOH");fi;
w:=wn;
# w:=Concatenation(w{[1..p-1]},lrules[pool[i]][2],
# w{[p+Length(lrules[pool[i]][1])..Length(w)]});
red:=true;
else
i:=i+1;
fi;
od;
until red=false;
return AssocWordByLetterRep(FamilyObj(One(fm)),w);
end;
homs:=ShallowCopy(dec.homs);
mos:=[];
off:=Length(mgens);
dept:=[];
lode:=[];
# go up so we may reduce tails
for i in [Length(homs),Length(homs)-1..1] do
Add(dept,off);
if IsGeneralPcgs(homs[i]) then
if Length(dec.abpow[i])>0 then
ffp:=FreeAbelianGroup(Length(homs[i])*(Length(dec.abpow[i])+1));
# relations: order
m:=GeneratorsOfGroup(ffp);
r:=List(m,x->x^RelativeOrders(homs[i])[1]);
# power dependence
for j in [1..Length(dec.abpow[i])] do
for k in [1..Length(homs[i])] do
Add(r,m[Length(homs[i])*(j-1)+k]^dec.abpow[i][j]
/m[Length(homs[i])*j+k]);
od;
od;
ffp:=ffp/r;
else
ffp:=AbelianGroup(IsFpGroup,RelativeOrders(homs[i]));
fi;
else
ffp:=Range(homs[i]);
fi;
imo:=IsomorphismFpMonoid(ffp);
Add(mos,imo);
m:=Range(imo);
loff:=off-Length(GeneratorsOfMonoid(m));
monreps:=fmgens{[loff+1..off]};
monreal:=mgens{[loff+1..off]};
if IsBound(m!.rewritingSystem) then
k:=m!.rewritingSystem;
else
k:=KnuthBendixRewritingSystem(m);
fi;
if HasLevelsOfGenerators(k!.ordering) then
Add(lode,LevelsOfGenerators(k!.ordering));
else
Add(lode,fail);
fi;
MakeConfluent(k);
# convert rules
for r in Rules(k) do
left:=MappedWord(r[1],FreeGeneratorsOfFpMonoid(m),monreps);
right:=MappedWord(r[2],FreeGeneratorsOfFpMonoid(m),monreps);
diff:=LeftQuotient(PreImagesRepresentative(iso,right),
PreImagesRepresentative(iso,left));
diff:=ImagesRepresentative(iso,diff);
left:=MappedWord(r[1],FreeGeneratorsOfFpMonoid(m),monreal);
right:=MappedWord(r[2],FreeGeneratorsOfFpMonoid(m),monreal);
if not IsOne(diff) then
right:=right*Product(List(LetterRepAssocWord(UnderlyingElement(diff)),
x->mgens[Position(nums,x)]));
fi;
right:=reduce(right); # monoid word might change
addrule([left,right]);
od;
for j in [loff+1..off] do
# if the generator gets reduced away, won't need to use it
if reduce(mgens[j])=mgens[j] then
for k in [off+1..Length(mgens)] do
if reduce(mgens[k])=mgens[k] then
right:=fmgens[j]^-1*fmgens[k]*fmgens[j];
#collect
right:=ImagesRepresentative(iso,PreImagesRepresentative(iso,right));
right:=Product(List(LetterRepAssocWord(UnderlyingElement(right)),
x->mgens[Position(nums,x)]));
right:=reduce(mgens[j]*right);
#Print("Did rule ",mgens[k],"*",mgens[j],"->",right,"\n");
addrule([mgens[k]*mgens[j],right]);
fi;
od;
fi;
od;
#if i<Length(homs) then Error("ZU");fi;
off:=loff;
od;
Add(dept,off);
# calculate levels for ordering
dept:=dept+1;
dept:=List([1..Length(mgens)],
x->PositionProperty(dept,y->x>=y)-1);
# are there local levels to keep? First make them fractional additions
off:=10^(1+LogInt(Length(dept),10)); # cent level for local depths
for i in [1..Maximum(dept)] do
if lode[i]<>fail then
diff:=Filtered([1..Length(dept)],x->dept[x]=i);
dept{diff}:=dept{diff}+lode[i]/off;
fi;
od;
if ForAny(dept,x->not IsInt(x)) then
# reintegralize
diff:=Set(dept);
dept:=List(dept,x->Position(diff,x));
fi;
# if AssertionLevel()>1 and ForAny(rules,x->x[2]<>reduce(x[2])) then
# Error("irreduced right");
# fi;
# inverses are true inverses, also for extension
for i in [1..Length(gens)] do
left:=mgens[2*i-1]*mgens[2*i];
left:=reduce(left);
if left<>One(fm) then addrule([left,One(fm)]); fi;
left:=mgens[2*i]*mgens[2*i-1];
left:=reduce(left);
if left<>One(fm) then addrule([left,One(fm)]); fi;
od;
fi;
# finally create
m:=FactorFreeMonoidByRelations(fm,rules);
hom:=MakeFpGroupToMonoidHomType1(fp,m);
j:=rec(fphom:=iso,monhom:=hom);
if dept=fail then
j.ordering:=k!.ordering;
else
j.ordering:=WreathProductOrdering(fm,dept);
fi;
k:=KnuthBendixRewritingSystem(FamilyObj(One(m)),j.ordering:isconfluent);
MakeConfluent(k); # will store in monoid as reducedConfluent
return j;
end);
# special method for pc groups, basically just writing down the pc
# presentation
InstallMethod(ConfluentMonoidPresentationForGroup,"pc",
[IsGroup and IsFinite and IsPcGroup],
function(G)
local pcgs,iso,fp,i,j,gens,numi,ord,fm,fam,mword,k,r,addrule,a,e,m;
pcgs:=Pcgs(G);
iso:=IsomorphismFpGroup(G);
fp:=Range(iso);
if List(GeneratorsOfGroup(fp),x->PreImagesRepresentative(iso,x))<>pcgs then
Error("pcgs");
fi;
gens:=[];
numi:=[];
ord:=[];
for i in [1..Length(pcgs)] do
Add(gens,String(fp.(i)));
Add(gens,String(fp.(i)^-1));
Add(numi,i);
Add(numi,-i);
Append(ord,[i,i]);
od;
fm:=FreeMonoid(gens);
fam:=FamilyObj(One(fm));
mword:=w->AssocWordByLetterRep(fam,
List(LetterRepAssocWord(UnderlyingElement(w)),x->Position(numi,x)));
ord:=WreathProductOrdering(fm,Reversed(ord));
k:=CreateKnuthBendixRewritingSystem(FamilyObj(One(fm/[])),ord);
if AssertionLevel()<=2 then
# assertion level <=2 so the auto tests will never trigger it
Unbind(k!.pairs2check);
fi;
addrule:=function(rul)
#Print("Add:",rul,"\n");
AddRuleReduced(k,List(rul,LetterRepAssocWord));
#Print(Rules(k),"\n");
end;
for i in [Length(pcgs),Length(pcgs)-1..1] do
if RelativeOrders(pcgs)[i]>2 then
addrule([mword(fp.(i))*mword(fp.(i)^-1),One(fm)]);
addrule([mword(fp.(i)^-1)*mword(fp.(i)),One(fm)]);
fi;
for j in [Length(pcgs),Length(pcgs)-1..i+1] do
for e in [[1,1],[1,-1],[-1,1],[-1,-1]] do
if (RelativeOrders(pcgs)[j]>2 or e[1]=1) and
(RelativeOrders(pcgs)[i]>2 or e[2]=1) then
a:=(pcgs[j]^e[1])^(pcgs[i]^e[2]);
addrule([mword(fp.(j)^e[1]*fp.(i)^e[2]),mword(fp.(i)^e[2])*mword(a)]);
fi;
od;
od;
r:=RelativeOrders(pcgs)[i];
if r=2 then
a:=ImagesRepresentative(iso,pcgs[i]^2);
addrule([mword(fp.(i)^2),mword(a)]);
a:=ImagesRepresentative(iso,pcgs[i]^-2);
addrule([mword(fp.(i)^-1),mword(fp.(i))*mword(a)]);
else
a:=ImagesRepresentative(iso,pcgs[i]^r);
addrule([mword(fp.(i)^((r+1)/2)),mword(fp.(i)^(-(r-1)/2))*mword(a)]);
a:=ImagesRepresentative(iso,pcgs[i]^-r);
addrule([mword(fp.(i)^(-(r+1)/2)),mword(fp.(i)^((r-1)/2))*mword(a)]);
fi;
if IsBound(k!.pairs2check) then
e:=StructuralCopy(Rules(k));
MakeConfluent(k);
Assert(3,Set(Rules(k))=Set(e));
fi;
od;
SetIsConfluent(k,true);
SetIsReduced(k,true);
m:=fm/Rules(k);
a:=MakeFpGroupToMonoidHomType1(fp,m);
SetReducedConfluentRewritingSystem(m,k);
j:=rec(fphom:=iso,monhom:=a,ordering:=ord);
return j;
end);
# ser is a string indicating the series (A, B, C, D, E, F), n is a number. If argument `false` is added, only braid
# relations
BindGlobal("WeylGroupFp",function(ser,n,docox...)
local f,rels,i,j,gens,coxrel;
coxrel:=function(a,b,n)
local m,f,g;
if n=2 then Add(rels,Comm(a,b));
else
if docox then
# coxeter: no negative exponents
Add(rels,(a*b)^n);
else
# braid: bababa... = ababab...
m:=QuoInt(n+1,2);
f:=Subword((b*a)^m,1,n);
g:=Subword((a*b)^m,1,n);
Add(rels,f/g);
fi;
fi;
end;
f:=FreeGroup(List([1..n],x->Concatenation("s",String(x))));
gens:=GeneratorsOfGroup(f);
if Length(docox)=0 then
docox:=true;
else
docox:=docox[1]=true;
fi;
if docox then
rels:=List(gens,x->x^2);
else
rels:=[];
fi;
if ser="A" then
for i in [1..n] do
for j in [1..i-1] do
if i-j>1 then
coxrel(gens[j],gens[i],2);
else
coxrel(gens[j],gens[i],3);
fi;
od;
od;
elif ser="B" or ser="C" then
for i in [1..n] do
for j in [1..i-1] do
if i-j>1 then
coxrel(gens[j],gens[i],2);
elif j=1 then
coxrel(gens[j],gens[i],4);
else
coxrel(gens[j],gens[i],3);
fi;
od;
od;
elif ser="D" and n>=4 then
coxrel(gens[1],gens[2],2);
coxrel(gens[1],gens[3],3);
coxrel(gens[2],gens[3],3);
for i in [4..n] do
for j in [1..i-1] do
if i-j>1 then
coxrel(gens[j],gens[i],2);
else
coxrel(gens[j],gens[i],3);
fi;
od;
od;
elif ser="E" then
# 1-2-3-5-6-7-8
# |
# 4
coxrel(gens[1],gens[2],3);
coxrel(gens[2],gens[3],3);
coxrel(gens[3],gens[4],3);
coxrel(gens[3],gens[5],3);
coxrel(gens[5],gens[6],3);
coxrel(gens[1],gens[3],2);
coxrel(gens[1],gens[4],2);
coxrel(gens[2],gens[4],2);
coxrel(gens[1],gens[5],2);
coxrel(gens[2],gens[5],2);
coxrel(gens[4],gens[5],2);
coxrel(gens[1],gens[6],2);
coxrel(gens[2],gens[6],2);
coxrel(gens[3],gens[6],2);
coxrel(gens[4],gens[6],2);
if n>=7 then
coxrel(gens[6],gens[7],3);
for i in [1..5] do
coxrel(gens[i],gens[7],2);
od;
fi;
if n=8 then
coxrel(gens[7],gens[8],3);
for i in [1..6] do
coxrel(gens[i],gens[8],2);
od;
elif n>8 then
Error("E>8 does not exist");
fi;
elif ser="F" and n=4 then
coxrel(gens[1],gens[2],3);
coxrel(gens[2],gens[3],4);
coxrel(gens[3],gens[4],3);
coxrel(gens[1],gens[3],2);
coxrel(gens[1],gens[4],2);
coxrel(gens[2],gens[4],2);
elif ser="G" and n=2 then
coxrel(gens[1],gens[2],6);
else
Error("series ",ser," not yet done");
fi;
return f/rels;
end);
BindGlobal("IsomorphismFpGroupForWeyl",
function(G)
local iso,n,fn,sz,bigcount,tryweyl;
tryweyl:=function(ser,n)
local H,isp,P,iso;
H:=WeylGroupFp(ser,n);
isp:=IsomorphismPermGroup(H);
P:=Image(isp,H);
iso:=IsomorphismGroups(G,P);
if iso<>fail then
P:=List(GeneratorsOfGroup(H),
x->PreImagesRepresentative(iso,ImagesRepresentative(isp,x)));
iso:=GroupHomomorphismByImagesNC(G,H,P,GeneratorsOfGroup(H));
fi;
return iso;
end;
# try to identify Weyl series
n:=0;
fn:=1;
repeat
n:=n+1;
fn:=fn*n;
bigcount:=0;
sz:=fn*(n+1);
if Size(G)<sz then bigcount:=bigcount+1;
elif Size(G)=sz and IsSymmetricGroup(G) then
# try Sn
if HasIsomorphismFpGroup(G) then
# We can access the special `symmetric' presentation only as method
# for `IsomorphismFp` for the symmetric group. But if such an
# isomorphism is already stored, it might be a different one.
# In this case recreate a new group that will then get it (because
# it is symmetric).
G:=Group(GeneratorsOfGroup(G));
SetSize(G,sz);
SetIsSymmetricGroup(G,true);
fi;
return IsomorphismFpGroup(G); # uses symmetric method
fi;
sz:=2^n*fn;
if Size(G)<sz then bigcount:=bigcount+1;
elif Size(G)=sz then
iso:=tryweyl("B",n);
if iso<>fail then return iso;fi;
fi;
sz:=2^(n-1)*fn;
if Size(G)<sz then bigcount:=bigcount+1;
elif n>=4 and Size(G)=sz then
iso:=tryweyl("D",n);
if iso<>fail then return iso;fi;
fi;
until bigcount=3;
if Size(G)=12 then
iso:=tryweyl("G",2);
if iso<>fail then return iso;fi;
elif Size(G)=1152 then
iso:=tryweyl("F",4);
if iso<>fail then return iso;fi;
elif Size(G)=51840 then
iso:=tryweyl("E",6);
if iso<>fail then return iso;fi;
elif Size(G)=72*Factorial(8) then
iso:=tryweyl("E",7);
if iso<>fail then return iso;fi;
elif Size(G)=192*Factorial(10) then
iso:=tryweyl("E",8);
if iso<>fail then return iso;fi;
fi;
return fail;
end);
BindGlobal("CanoDC",function(chain,sub,orep)
local i,j,u,o,r,stb,m,g,img,p,rep,b,expand,dict,act,gens,gf,writestab;
expand:=function(n)
local e;
e:=r[n][2];
while r[n][1]<>0 do
n:=r[n][1];
e:=r[n][2]*e;
od;
return e;
end;
writestab:=function()
local p,k;
p:=stb;
if Length(p)>3 then
# permute randomly
p:=p{FLOYDS_ALGORITHM(
GlobalMersenneTwister,Length(stb),false)};
fi;
stb:=SubgroupNC(sub,p{[1..Minimum(3,Length(p))]});
for k in p{[4..Length(p)]} do
stb:=ClosureSubgroupNC(stb,k);
od;
end;
b:=One(sub);
rep:=orep;
for i in [Length(chain)-1,Length(chain)-2..1] do
u:=chain[i];
act:=function(e,g) return CanonicalRightCosetElement(u,e*g);end;
# orbit/rep stabilizer
o:=[CanonicalRightCosetElement(u,rep)];
dict:=NewDictionary(rep,true,Last(chain));
AddDictionary(dict,o[1],1);
r:=[[0,One(sub)]];
stb:=[];
#stb:=TrivialSubgroup(sub);
j:=1;
m:=1;
gens:=GeneratorsOfGroup(sub);
gf:=true;
while j<=Length(o) and Length(o)*Size(stb)<Size(sub) do
if gf and Length(o)>40 then
gf:=false;
gens:=SmallGeneratingSet(sub);
fi;
for g in gens do
img:=act(o[j],g);
#p:=Position(o,img);
p:=LookupDictionary(dict,img);
if p=fail then
Add(o,img);
AddDictionary(dict,img,Length(o));
Add(r,[j,g]);
#Add(r,[0,r[j][2]*g]);
if img<o[m] then m:=Length(o); fi;
elif IsList(stb) then
AddSet(stb,expand(j)*g/expand(p));
if Length(o)>20 then
writestab();
fi;
else
stb:=ClosureSubgroupNC(stb,expand(j)*g/expand(p));
fi;
od;
j:=j+1;
od;
b:=b*expand(m);
j:=expand(m);
rep:=rep*j;
if i>1 then
if IsList(stb) then writestab();fi;
sub:=stb^j;
fi;
od;
return [o[m],b];
end);
# rewriting systems for simple groups based on BN pairs, following
# (Schmidt, Finite groups have short rewriting systems. Computational group
# theory and the theory of groups, II, 185–200, Contemp. Math., 511.)
BindGlobal("SplitBNRewritingPresentation",function(group,borel,weyl,newstyle)
local isob,isos,iso,gens,a,rels,l,i,j,bgens,cb,cs,b,f,k,w,monoid,
lev,ord,monb,mons,gp,trawo,trawou,hom,tst,dc,dcreps,act,decomp,ranb,ranw,
nofob,nofow,reduce,pcgs,can,pri,stb,addrule,invmap,jj,wo,pciso,
borelelm,borelran,borelreduce,bpairs,brws,specialborelreduce,
rdag,mdag,wdag,dcnum,dcfix,
rt,dcnums,rti,maketzf,mytzf,csetperm,pc,bpcgs,noncomm,noncelm,
wgens,weylword,borelword,coxrels,ha,directerr,bhom,ac,relab,ostab,dcr,single;
specialborelreduce:=false;
if Size(ClosureGroup(borel,weyl))<Size(group) then return fail;fi;
ha:=Intersection(borel,weyl);
dc:=DoubleCosets(group,borel,borel);
if newstyle then
# use exactly the generators of borel
bpcgs:=PcgsByPcSequence(FamilyObj(One(borel)),GeneratorsOfGroup(borel));
pc:=PcGroupWithPcgs(bpcgs);
pciso:=GroupHomomorphismByImages(borel,pc,bpcgs,FamilyPcgs(pc));
cb:=ConfluentMonoidPresentationForGroup(pc);
else
if Size(Intersection(borel,weyl))>1 then
# can we fix this?
# assume weyl is not too large
cs:=Concatenation(List(ConjugacyClassesSubgroups(weyl),AsList));;
SortBy(cs,x->-Size(x));
l:=false;
i:=1;
while l=false and i<=Length(cs) do
if Size(Intersection(borel,cs[i]))=1 and Size(cs[i])>=Length(dc)
and Size(ClosureGroup(borel,cs[i]))=Size(group) and
Length(Set(Elements(cs[i]),
x->PositionProperty(dc,y->x in y)))=Length(dc) then
Info(InfoFpGroup,1,"replaced weyl candidate with better subgroup\n");
l:=cs[i];
fi;
i:=i+1;
od;
if l<>false then
weyl:=l;
fi;
fi;
# Use SpecialPcgs for borel
pciso:=IsomorphismSpecialPcGroup(borel);
cb:=ConfluentMonoidPresentationForGroup(Range(pciso));
fi;
brws:=ReducedConfluentRewritingSystem(Range(cb.monhom));
# force going to pc group, as this will give better ordering
isob:=GroupHomomorphismByFunction(borel,Range(cb.fphom),
x->ImagesRepresentative(cb.fphom,ImagesRepresentative(pciso,x)),
x->PreImagesRepresentative(pciso,PreImagesRepresentative(cb.fphom,x)));
b:=Range(isob);
wgens:=GeneratorsOfGroup(weyl);
bgens:=List(GeneratorsOfGroup(b),x->PreImagesRepresentative(isob,x));
if newstyle and bgens<>GeneratorsOfGroup(borel) then Error("gens");fi;
bpairs:=Concatenation(List(bgens,x->[x,x^-1]));
monoid:=Range(cb.monhom);
borelran:=[]; # initially no special borelran
# borel-only reduction to deal with large primes
borelreduce:=function(w)
local i,j,need;
i:=1;
repeat
# find borel range
while i<Length(w) and not (w[i] in borelran) do
i:=i+1;
od;
if i<Length(w) and w[i+1] in borelran then
j:=i;
need:=false;
while j+1<=Length(w) and w[j+1] in borelran do
j:=j+1;
if need=false and QuoInt(w[j-1]+1,2)=QuoInt(w[j]+1,2) # element and inverse
or w[j]<w[j-1] # wrong order
then need:=true;
fi;
od;
if need then
need:=w{[i..j]};
need:=Product(bpairs{need});
need:=ImagesRepresentative(cb.monhom,ImagesRepresentative(isob,need));
need:=UnderlyingElement(need);
if Length(need)>0 then
need:=ReducedForm(brws,need);
fi;
w:=Concatenation(w{[1..i-1]},LetterRepAssocWord(need),w{[j+1..Length(w)]});
i:=i+Length(need);
else
i:=j+1;
fi;
else
if i<Length(w) then i:=i+2;fi;
fi;
until i>=Length(w);
return w;
end;
maketzf:=function(rules)
local tzf,tzrules,p,i;
tzrules:=List(rules,x->List(x,LetterRepAssocWord));
tzf:=[];
for i in tzrules do
p:=i[1][1];
if not IsBound(tzf[p]) then
tzf[p]:=[i];
else
Add(tzf[p],i);
fi;
od;
return tzf;
end;
reduce:=function(wo,rules,dag,tzf)
local w,fam,red,i,j,p,ww,sp,has;
#Print("Reduce ",wo,"\n");
fam:=FamilyObj(wo);
# is it in big monoid?
w:=LetterRepAssocWord(wo);
sp:=specialborelreduce and fam=FamilyObj(One(f)) and ForAny(w,x->x in borelran);
# collect from the left
if sp then
w:=borelreduce(w);
fi;
if dag<>fail then
repeat
has:=false;
p:=1;
while p<=Length(w) do
i:=RuleAtPosKBDAG(dag,w,p);
if i<>fail then
has:=true;
# replace
w:=Concatenation(w{[1..p-1]},LetterRepAssocWord(rules[i][2]),
w{[p+Length(rules[i][1])..Length(w)]});
if sp then
w:=borelreduce(w);
fi;
p:=0;
fi;
p:=p+1;
od;
until has=false;
else
p:=Length(w);
while p>0 do
if IsBound(tzf[w[p]]) then
red:=tzf[w[p]];
i:=1;
while i<=Length(red) do
if p+Length(red[i][1])-1<=Length(w) then
j:=2;
while j<=Length(red[i][1]) and w[p+j-1]=red[i][1][j] do
j:=j+1;
od;
if j>Length(red[i][1]) then
# replace
w:=Concatenation(w{[1..p-1]},red[i][2],
w{[p+Length(red[i][1])..Length(w)]});
#Print("intermed ",red[i],":",AssocWordByLetterRep(fam,w),"\n");
p:=Minimum(p+Length(red[i][2]),Length(w));
if sp then
ww:=borelreduce(w);
if ww<>w then
w:=ww;
p:=Length(w);
fi;
fi;
i:=Length(red);
fi;
fi;
i:=i+1;
od;
fi;
p:=p-1;
od;
fi;
w:=AssocWordByLetterRep(fam,w);
#Print("To ",w,"\n");
#if sp and w<>oreduce(wo,rules) then Error("baeh!");fi;
return w;
end;
nofob:=function(x)
x:=UnderlyingElement(ImagesRepresentative(cb.monhom,x));
x:=reduce(x,RelationsOfFpMonoid(monoid),mdag,fail);
x:=ElementOfFpMonoid(FamilyObj(One(monoid)),x);
return PreImagesRepresentative(cb.monhom,x);
end;
mdag:=EmptyKBDAG(Union(List(FreeGeneratorsOfFpMonoid(monoid),
LetterRepAssocWord)));
a:=RelationsOfFpMonoid(monoid);
for i in [1..Length(a)] do
AddRuleKBDAG(mdag,LetterRepAssocWord(a[i][1]),i);
od;
if newstyle then
if IsBound(weyl!.epiweyl) then
cs:=GroupHomomorphismByImages(weyl,weyl!.epiweyl,
GeneratorsOfGroup(weyl),GeneratorsOfGroup(weyl!.epiweyl));
if Size(ha)>1 then
w:=CompositionSeriesThrough(weyl,[ha]);
w:=Concatenation([weyl],Filtered(w,x->IsSubset(ha,x)));
cs:=IsomorphismFpGroupBySubnormalSeries(weyl,w,"w":knownfactor:=cs);
fi;
else
cs:=IsomorphismFpGroupByGenerators(weyl,wgens);
fi;
w:=IsomorphismFpMonoid(Range(cs));
k:=KnuthBendixRewritingSystem(Range(w));
MakeConfluent(k);
k:=Rules(k);
w:=FreeMonoidOfFpMonoid(Range(w))/k;
w:=MakeFpGroupToMonoidHomType1(Range(cs),w);
cs:=rec(fphom:=cs,monhom:=w);
else
cs:=IsomorphismFpGroupForWeyl(weyl);
if cs<>fail then
cs:=rec(fphom:=cs,monhom:=IsomorphismFpMonoid(Range(cs)));
else
cs:=ConfluentMonoidPresentationForGroup(weyl);
fi;
fi;
nofow:=function(x)
x:=UnderlyingElement(ImagesRepresentative(cs.monhom,x));
x:=reduce(x,RelationsOfFpMonoid(Range(cs.monhom)),wdag,fail);
x:=ElementOfFpMonoid(FamilyObj(One(Range(cs.monhom))),x);
return PreImagesRepresentative(cs.monhom,x);
end;
wdag:=EmptyKBDAG(Union(List(FreeGeneratorsOfFpMonoid(Range(cs.monhom)),
LetterRepAssocWord)));
a:=RelationsOfFpMonoid(Range(cs.monhom));
for i in [1..Length(a)] do
AddRuleKBDAG(wdag,LetterRepAssocWord(a[i][1]),i);
od;
isos:=cs.fphom;
w:=Range(isos);
a:=MappingGeneratorsImages(isos)[1];
gens:=bgens;
l:=Length(gens);
gens:=Concatenation(gens,a);
ac:=AscendingChain(group,borel);
Info(InfoFpGroup,1,List(ac,Size));
single:=IndexNC(group,borel)<10^7;
while Length(ac)>2 and
IndexNC(Last(ac),ac[Length(ac)-2])<10^7 do
ac:=ac{Difference([1..Length(ac)],[Length(ac)-1])};
od;
i:=Length(ac)-1;
while i>2 do
if IndexNC(ac[i],ac[i-2])<=100 then
ac:=ac{Difference([1..Length(ac)],[i-1])};
fi;
i:=i-1;
od;
# perm action of group on top, small gen set
rt:=RightTransversal(group,ac[Length(ac)-1]);
a:=Group(SmallGeneratingSet(group)); # so nothing stores
csetperm:=List(GeneratorsOfGroup(a),x->Permutation(x,rt,OnRight));
iso:=EpimorphismFromFreeGroup(a);
csetperm:=List(bgens,x->MappedWord(PreImagesRepresentative(iso,x),
MappingGeneratorsImages(iso)[1],csetperm));
act:=Group(csetperm,());
bhom:=GroupHomomorphismByImagesNC(borel,act,bgens,csetperm);
#Assert(0,bhom<>fail);
# reps for each coset
dcnums:=OrbitsDomain(act,[1..Length(rt)]);
dcnums:=List(dcnums,x->Immutable(Set(x)));
# ensure that "weyl group" represents double cosets (but allow double
# coverage)
rti:=List(dcnums,ReturnFalse); # which double are hit already
for i in weyl do
a:=PositionCanonical(rt,i);
j:=PositionProperty(dcnums,x->a in x);
if rti[j]=false then
rti[j]:=true;
if dcnums[j][1]<>a then
dcnums[j]:=Concatenation([a],Difference(dcnums[j],[a]));
fi;
fi;
od;
# index the orbit nr.
rti:=[];
ostab:=[];
for i in [1..Length(dcnums)] do
for j in dcnums[i] do
rti[j]:=i;
od;
a:=Stabilizer(borel,dcnums[i][1],bgens,csetperm,OnPoints);
a:=SubgroupNC(borel,SmallGeneratingSet(a));
ostab[i]:=a;
od;
ac:=ac{[1..Length(ac)-1]}; # remove top step
Info(InfoFpGroup,1,List(ac,Size));
Assert(0,single=(Length(ac)=1));
dcr:=function(elm)
local a,b,rep;
a:=PositionCanonical(rt,elm);
b:=rti[a];
rep:=RepresentativeAction(Image(bhom),a,dcnums[b][1]);
rep:=PreImagesRepresentative(bhom,rep);
if single then
a:=[CanonicalRightCosetElement(ac[1],rt[dcnums[b][1]]),rep];
else
a:=CanoDC(ac,ostab[b],elm*rep);
a:=[a[1],rep*a[2]];
fi;
if relab then
b:=Position(dcnum,a[1]);
a:=[dcreps[b],a[2]*dcfix[b]];
fi;
return a;
end;
# the calculated reps
relab:=false;
dcfix:=List(dc,x->One(group));
dcnum:=fail;
dcnum:=List(dc,x->dcr(Representative(x))[1]);
# ensure the Weyl group is the reps
dcreps:=[];
for i in AsList(weyl) do
j:=dcr(i);
a:=Position(dcnum,j[1]);
if not IsBound(dcreps[a]) then
dcreps[a]:=i;
dcfix[a]:=j[2]^-1; # mapping calculated to weyl elt
fi;
od;
if not ForAll([1..Length(dc)],x->IsBound(dcreps[x])) then
Error("weyl does not cover dc");
fi;
relab:=true;
decomp:=function(elm)
local rep,a;
if elm in borel then return [elm,One(borel),One(borel)];fi;
a:=dcr(elm);
rep:=a[2];
rep:=[elm*rep/a[1],a[1],rep^-1];
Assert(0,rep[1] in borel);
return rep;
end;
iso:=IsomorphismFpGroupByGenerators(group,gens);
# else # alternative, old, code
# # identify double cosets
# rt:=RightTransversal(group,borel);
#
# # perm action of group, small gen set
# a:=Group(SmallGeneratingSet(group)); # so nothing stores
# csetperm:=List(GeneratorsOfGroup(a),x->Permutation(x,rt,OnRight));
# iso:=EpimorphismFromFreeGroup(a);
# csetperm:=List(bgens,x->MappedWord(PreImagesRepresentative(iso,x),MappingGeneratorsImages(iso)[1],csetperm));
# act:=Group(csetperm,());
#
# bhom:=GroupHomomorphismByImagesNC(borel,act,bgens,csetperm);
# #Assert(0,bhom<>fail);
#
# dcnums:=OrbitsDomain(act,[1..Length(rt)]);
# dcnums:=List(dcnums,x->Immutable(Set(x)));
# rti:=[];
# for i in [1..Length(dc)] do
# a:=PositionCanonical(rt,Representative(dc[i]));
# a:=PositionProperty(dcnums,x->a in x);
# for j in dcnums[a] do
# rti[j]:=i;
# od;
# od;
# dcnums:=false; # clean memory
# iso:=false;
# act:=false;
#
# # BN decomposition
# dcreps:=[];
# for i in AsList(weyl) do
# #a:=PositionProperty(dc,y->i in y);
# a:=rti[PositionCanonical(rt,i)];
# if not IsBound(dcreps[a]) then dcreps[a]:=i;fi;
# od;
#
# if not ForAll([1..Length(dc)],x->IsBound(dcreps[x])) then
# Error("weyl does not cover dc");
# fi;
#
# iso:=IsomorphismFpGroupByGenerators(group,gens);
#
# act:=function(r,g)
# return CanonicalRightCosetElement(borel,r*g);
# end;
#
# decomp:=function(elm)
# local pos,rep;
# if elm in borel then return [elm,One(borel),One(borel)];fi;
# #pos:=PositionProperty(dc,y->elm in y);
# pos:=rti[PositionCanonical(rt,elm)];
# #rep:=RepresentativeAction(borel,PositionCanonical(rt,elm),
# # PositionCanonical(rt,dcreps[pos]),bgens,csetperm,OnPoints);
# rep:=PreImagesRepresentative(bhom,
# RepresentativeAction(Range(bhom),PositionCanonical(rt,elm),
# PositionCanonical(rt,dcreps[pos])));
# rep:=[elm*rep/dcreps[pos],dcreps[pos],rep^-1];
# Assert(0,rep[1] in borel);
# return rep;
# end;
# fi;
# now build new presentation
a:=[];
for i in [1..Length(GeneratorsOfGroup(b))] do
Add(a,Concatenation("b",String(i)));
od;
borelran:=[1..Length(a)];
for i in [1..Length(GeneratorsOfGroup(w))] do
Add(a,Concatenation("w",String(i)));
od;
f:=FreeGroup(a);
gens:=FreeGeneratorsOfFpGroup(f);
rels:=[];
# take the relators of both groups
ranb:=gens{[1..l]};
for i in RelatorsOfFpGroup(b) do
Add(rels,MappedWord(i,FreeGeneratorsOfFpGroup(b),ranb));
od;
ranw:=gens{[l+1..Length(gens)]};
for i in RelatorsOfFpGroup(w) do
Add(rels,MappedWord(i,FreeGeneratorsOfFpGroup(w),ranw));
od;
# throw in relators for the whole group, so we guarantee a presentation
Append(rels,List(RelatorsOfFpGroup(Range(iso)),
--> --------------------
--> maximum size reached
--> --------------------
[ Dauer der Verarbeitung: 0.51 Sekunden
(vorverarbeitet)
]
|
