| Current Path : /usr/share/gap/lib/ |
Linux ift1.ift-informatik.de 5.4.0-216-generic #236-Ubuntu SMP Fri Apr 11 19:53:21 UTC 2025 x86_64 |
| Current File : //usr/share/gap/lib/autsr.gi |
#############################################################################
##
#W autsr.gi GAP library Alexander Hulpke
#W Soley Jonsdottir
##
##
#Y Copyright (C) 2016 The GAP Group
##
## This file contains an implementation of the Cannon/Holt automorphism
## group algorithm.
BindGlobal("AGSRPrepareAutomLift",function(G,pcgs,nat)
local ocr, fphom, fpg, free, len, dim, tmp, L0, S, R, rels, mat, r, RS, i, g, v;
ocr:=rec(group:=G,modulePcgs:=pcgs);
fphom:=IsomorphismFpGroup(G);
ocr.identity := One(ocr.modulePcgs[1]);
fpg:=FreeGeneratorsOfFpGroup(Range(fphom));
ocr.factorpres:=[fpg,RelatorsOfFpGroup(Range(fphom))];
ocr.generators:=List(GeneratorsOfGroup(Range(fphom)),
i->PreImagesRepresentative(fphom,i));
OCAddMatrices(ocr,ocr.generators);
OCAddRelations(ocr,ocr.generators);
OCAddSumMatrices(ocr,ocr.generators);
OCAddToFunctions(ocr);
ocr.module:=GModuleByMats(
LinearActionLayer(G,ocr.generators,ocr.modulePcgs),ocr.field);
ocr.moduleauts:=MTX.ModuleAutomorphisms(ocr.module);
ocr.factorgens:=List(ocr.generators,i->Image(nat,i));
free:=FreeGroup(Length(ocr.generators),"f");
ocr.free:=free;
ocr.decomp:=GroupGeneralMappingByImages(Image(nat,G),free,
ocr.factorgens,GeneratorsOfGroup(free));
# Initialize system.
len:=Length(ocr.generators);
dim:=Length(pcgs);
tmp := ocr.moduleMap( ocr.identity );
L0 := Concatenation( List( [ 1 .. len ], x -> tmp ) );
ConvertToVectorRep(L0,ocr.field);
S := List( [ 1 .. len * dim ], x -> L0 );
R := ListWithIdenticalEntries( len * dim,Zero( ocr.field ) );
ConvertToVectorRep(R,ocr.field);
rels:=ocr.relators;
mat:=List([1..len*dim],x->[]);
for i in mat do
ConvertToVectorRep(i,ocr.field);
od;
for i in [1..Length(rels)] do
Info(InfoCoh,2," relation ", i, " (",Length(rels),")");
r:=1;
for g in [1..len] do
RS:=OCEquationMatrix(ocr,rels[i],g);
for v in RS do
Append(mat[r],v);
r:=r+1;
od;
od;
od;
ocr.matrix:=mat;
return ocr;
end);
#############################################################################
##
#F OCEquationVectorAutom(<ocr>,<r>,<genimages>)
##
BindGlobal("OCEquationVectorAutom",function(ocr,r,genimages)
local n,i;
# If <r> has an entry 'conjugated' the records is no relator for a
# presentation,but belongs to relation
# (g_i n_i) ^ s_j =<r>
# which is used to determinate normal complements. [i,j] is bound to
# <conjugated>.
if IsBound(r.conjugated) then
Error("not yet implemented");
fi;
n:=ocr.identity;
for i in [1 .. Length(r.generators)] do
n:=n*genimages[r.generators[i]]^r.powers[i];
od;
Assert(1,n in GroupByGenerators(NumeratorOfModuloPcgs(ocr.modulePcgs)));
return ShallowCopy(ocr.moduleMap(n));
end);
BindGlobal("AGSRAutomLift",function(ocr,nat,fhom,miso)
local v, rels, genimages, v1, psim, w, s, t, l, hom, i, e, j,ep,phom;
v:=[];
rels:=ocr.relators;
genimages:=List(ocr.factorgens,i->MappedWord(
ImagesRepresentative(ocr.decomp,Image(fhom,i)),
GeneratorsOfGroup(ocr.free),
ocr.generators));
for i in [1..Length(rels)] do
v1:=OCEquationVectorAutom(ocr,rels[i],genimages);
Add(v,v1);
od;
#for ep in Enumerator(ocr.moduleauts) do
phom:=IsomorphismPermGroup(ocr.moduleauts);
for ep in Enumerator(Image(phom)) do
e:=PreImagesRepresentative(phom,ep);
psim:=e*miso;
psim:=psim^-1;
w:=-List(v,i->i*psim);
s:=SolutionMat(ocr.matrix,Concatenation(w));
if s<>fail then
psim:=psim^-1;
t:=[];
ConvertToVectorRep(t,ocr.field);
l:=Length(ocr.modulePcgs);
for i in [1..Length(genimages)] do
v1:=s{[(i-1)*l+1..(i*l)]}*psim;
for j in [1..Length(v1)] do
t[(i-1)*l+j]:=v1[j];
od;
od;
s:=ocr.cocycleToList(t);
for i in [1..Length(genimages)] do
genimages[i]:=genimages[i]*s[i];
od;
# later use NC version
hom:=GroupHomomorphismByImagesNC(ocr.group,ocr.group,
ocr.generators,genimages);
Assert(2,IsBijective(hom));
return hom;
fi;
od;
return fail;
end);
# main automorphism method -- currently still using factor groups, but
# nevertheless faster..
# option somechar may be a list of characterstic subgroups, or a record with
# component subgroups, orbits
BindGlobal("AutomGrpSR",function(G)
local ff,r,d,ser,u,v,i,j,k,p,bd,e,gens,lhom,M,N,hom,Q,Mim,q,ocr,split,MPcgs,
b,fratsim,AQ,OQ,Zm,D,innC,bas,oneC,imgs,C,maut,innB,tmpAut,imM,a,A,B,
cond,sub,AQI,AQP,AQiso,rf,res,resperm,proj,Aperm,Apa,precond,ac,
comiso,extra,mo,rada,makeaqiso,ind,lastperm,actbase,somechar,stablim,
scharorb,asAutom,jorb,jorpo,substb,isBadPermrep,ma;
# criterion for when to force degree reduction
isBadPermrep:=function(g)
return NrMovedPoints(g)^2>Size(g)*Index(g,DerivedSubgroup(g));
end;
asAutom:=function(sub,hom) return Image(hom,sub);end;
actbase:=ValueOption("autactbase");
makeaqiso:=function()
local a,b;
if HasIsomorphismPermGroup(AQ) then
AQiso:=IsomorphismPermGroup(AQ);
elif HasNiceMonomorphism(AQ) and IsPermGroup(Range(NiceMonomorphism(AQ))) then
AQiso:=NiceMonomorphism(AQ:autactbase:=fail);
elif actbase<>fail then
AQiso:=IsomorphismPermGroup(AQ:autactbase:=List(actbase,x->Image(hom,x)));
else
AQiso:=IsomorphismPermGroup(AQ);
fi;
Info(InfoMorph,3,"Permrep of AQ ",Size(AQ));
AQP:=Image(AQiso,AQ);
# force degree down
a:=Size(AQP);
AQP:=Group(SmallGeneratingSet(AQP),One(AQP));
SetSize(AQP,a);
if isBadPermrep(AQP) then
a:=SmallerDegreePermutationRepresentation(AQP:cheap);
if NrMovedPoints(Image(a))<NrMovedPoints(AQP) then
Info(InfoMorph,3,"Permdegree reduced ",
NrMovedPoints(AQP),"->",NrMovedPoints(Image(a)));
AQiso:=AQiso*a;
b:=Image(a,AQP);
if Length(GeneratorsOfGroup(b))>Length(GeneratorsOfGroup(AQP)) then
b:=Group(List(GeneratorsOfGroup(AQP),x->ImagesRepresentative(a,x)));
SetSize(b,Size(AQP));
fi;
AQP:=b;
fi;
fi;
end;
stablim:=function(gp,cond,lim)
local no,same,sz,ac,i,sub;
same:=true;
repeat
sz:=Size(Aperm);
if Size(gp)/Size(Aperm)>lim then
no:=Normalizer(gp,Aperm);
if Size(no)>Size(Aperm) and Size(no)<Size(gp) then
stablim(no,cond,lim);
fi;
else
no:=Aperm;
fi;
if Size(gp)/Size(Aperm)>lim then
ac:=AscendingChain(gp,Aperm);
List(Union(List(ac,GeneratorsOfGroup)),cond); # try generators...
if Size(Aperm)>sz then
ac:=Unique(List(ac,x->ClosureGroup(Aperm,x)));
fi;
i:=First([Length(ac),Length(ac)-1..1],x->Size(ac[x])/sz<=lim);
sub:=ac[i];
else
sub:=gp;
fi;
if Size(sub)>Size(Aperm) and not IsSubset(no,sub) then
SubgroupProperty(sub,cond,Aperm);
fi;
same:=Size(Aperm)=sz;
if not same then
Info(InfoMorph,3,"stablim improves by ",Size(Aperm)/sz,
" remaining ",Size(gp)/Size(Aperm));
fi;
until same;
return sub=gp;
end;
ff:=FittingFreeLiftSetup(G);
r:=ff.radical;
# find series through r
# derived and then primes and then elementary abelian
d:=ValueOption("series");
if d=fail then
d:=DerivedSeriesOfGroup(r);
# refine
d:=RefinedSubnormalSeries(d,Centre(r));
scharorb:=fail;
somechar:=ValueOption("someCharacteristics");
if somechar<>fail then
if IsRecord(somechar) then
if IsBound(somechar.orbits) then
scharorb:=somechar.orbits;
fi;
somechar:=somechar.subgroups;
fi;
for i in somechar do
d:=RefinedSubnormalSeries(d,i);
od;
fi;
for i in PrimeDivisors(Size(r)) do
u:=PCore(r,i);
if Size(u)>1 then
d:=RefinedSubnormalSeries(d,u);
j:=1;
repeat
v:=Agemo(u,i,j);
if Size(v)>1 then
d:=RefinedSubnormalSeries(d,v);
fi;
j:=j+1;
until Size(v)=1;
j:=1;
repeat
v:=Omega(u,i,j);
if Size(v)<Size(u) then
d:=RefinedSubnormalSeries(d,v);
fi;
j:=j+1;
until Size(v)=Size(u);
fi;
od;
Assert(1,ForAll([1..Length(d)-1],x->Size(d[x])<>Size(d[x+1])));
d:=Reversed(d);
else
d:=ShallowCopy(d);
SortBy(d,Size); # in case reversed order....
fi;
ser:=[TrivialSubgroup(G)];
for i in d{[2..Length(d)]} do
u:=ser[Length(ser)];
for p in PrimeDivisors(Size(i)/Size(u)) do
bd:=PValuation(Size(i)/Size(u),p); # max p-exponent
u:=ClosureSubgroup(u,SylowSubgroup(i,p));
v:=ser[Length(ser)];
while not HasElementaryAbelianFactorGroup(u,v) do
gens:=Filtered(GeneratorsOfGroup(u),x->not x in v);
e:=List(gens,x->First([1..bd],a->x^(p^a) in v));
e:=p^(Maximum(e)-1);
for j in gens do
v:=ClosureSubgroup(v,j^e);
od;
Add(ser,v);
od;
Add(ser,u);
od;
od;
rada:=fail;
ser:=Reversed(ser);
i:=1;
hom:=ff.factorhom;
Q:=Image(hom,G);
if IsPermGroup(Q) and NrMovedPoints(Q)/Size(Q)*Size(Socle(Q))
>SufficientlySmallDegreeSimpleGroupOrder(Size(Q)) then
# just in case the radical factor hom is inherited.
Q:=SmallerDegreePermutationRepresentation(Q);
Info(InfoMorph,3,"Radical factor degree reduced ",NrMovedPoints(Range(hom)),
" -> ",NrMovedPoints(Range(Q)));
hom:=hom*Q;
Q:=Image(hom,G);
fi;
ma:=MaximalSubgroupClassesSol(G);
AQ:=AutomorphismGroupFittingFree(Q:someCharacteristics:=fail);
AQI:=InnerAutomorphismsAutomorphismGroup(AQ);
lastperm:=fail;
while i<Length(ser) do
Assert(2,ForAll(GeneratorsOfGroup(AQ),x->Size(Source(x))=Size(Q)));
# ensure that the step is OK
lhom:=hom;
OQ:=Q;
repeat
Info(InfoMorph,4,List(ser,Size)," ",i);
Info(InfoMorph,1,"Step ",i," ",Size(ser[i]),"->",Size(ser[i+1]));
M:=ser[i];
N:=ser[i+1];
hom:=NaturalHomomorphismByNormalSubgroup(G,N);
Q:=Image(hom,G);
# degree reduction called for?
if Size(N)>1 and isBadPermrep(Q) then
#if NrMovedPoints(Q)>15000 then Error("egad!");fi;
q:=SmallerDegreePermutationRepresentation(Q);
Info(InfoMorph,3,"reduced permrep Q ",NrMovedPoints(Q)," -> ",
NrMovedPoints(Range(q)));
hom:=hom*q;
Q:=Image(hom,G);
fi;
# inherit radical factor map
q:=GroupHomomorphismByImagesNC(Q,Range(ff.factorhom),
List(GeneratorsOfGroup(G),x->ImagesRepresentative(hom,x)),
List(GeneratorsOfGroup(G),x->ImagesRepresentative(ff.factorhom,x)));
b:=Image(hom,ff.radical);
SetRadicalGroup(Q,b);
AddNaturalHomomorphismsPool(Q,b,q);
# Use known maximals for Frattini
for j in ma do
D:=Image(hom,j);
if not IsSubset(D,b) then
b:=Core(Q,NormalIntersection(b,D));
fi;
od;
SetIsNilpotentGroup(b,true);
SetFrattiniSubgroup(Q,b);
# M-factor
Mim:=Image(hom,M);
MPcgs:=Pcgs(Mim);
q:=GroupHomomorphismByImagesNC(Q,OQ,
List(GeneratorsOfGroup(G),x->ImagesRepresentative(hom,x)),
List(GeneratorsOfGroup(G),x->ImagesRepresentative(lhom,x)));
AddNaturalHomomorphismsPool(Q,Mim,q);
mo:=GModuleByMats(LinearActionLayer(GeneratorsOfGroup(Q),MPcgs),GF(RelativeOrders(MPcgs)[1]));
# is the extension split?
ocr:=OneCocycles(Q,Mim);
split:=ocr.isSplitExtension;
if not split then
# test: Semisimple and Frattini
b:=MTX.BasisRadical(mo);
fratsim:=Length(b)=0;
if not fratsim then
b:=List(b,x->PreImagesRepresentative(hom,PcElementByExponents(MPcgs,x)));
for j in b do
N:=ClosureSubgroup(N,b);
od;
# insert
for j in [Length(ser),Length(ser)-1..i+1] do
ser[j+1]:=ser[j];
od;
ser[i+1]:=N;
Info(InfoMorph,2,"insert1");
else
# Frattini?
fratsim:=IsSubset(FrattiniSubgroup(Q),Mim);
if not fratsim then
N:=Intersection(FrattiniSubgroup(Q),Mim);
# insert
for j in [Length(ser),Length(ser)-1..i+1] do
ser[j+1]:=ser[j];
od;
ser[i+1]:=PreImage(hom,N);
Info(InfoMorph,2,"insert2");
fi;
fi;
fi;
until split or fratsim;
# Use cocycles
b:=BasisVectors(Basis(ocr.oneCocycles));
# find D
Zm:=PreImage(q,Centre(OQ));
D:=Centralizer(Zm,Mim);
innC:=List(GeneratorsOfGroup(D),d->InnerAutomorphism(Q,d));
D:=List(innC,inn->List(ocr.generators,o->Image(inn,o)));
D:=List(D,d->List([1..Length(ocr.generators)],i->ocr.generators[i]^-1*d[i]));
D:=List(D,d->ocr.listToCocycle(d));
TriangulizeMat(D);
D:=Filtered(D,x->x<>0*x);
b:=BaseSteinitzVectors(b,D).factorspace;
C:=[];
if Size(Group(ocr.generators))<Size(Q) then
extra:=MPcgs;
else
extra:=[];
fi;
for j in b do
oneC := ocr.cocycleToList( j );
imgs:=List([1..Length(ocr.generators)],i->ocr.generators[i]*oneC[i]);
oneC:=GroupHomomorphismByImagesNC(Q,Q,Concatenation(ocr.generators,extra),Concatenation(imgs,extra));
Assert(2,IsBijective(oneC));
Add(C,oneC);
od;
B:=[];
if lastperm<>fail then
AQiso:=lastperm;
AQP:=Group(List(GeneratorsOfGroup(AQ),x->ImagesRepresentative(AQiso,x)));
else
makeaqiso();
fi;
if split then
maut:=MTX.ModuleAutomorphisms(mo);
# find noninner of B
innB:=List(SmallGeneratingSet(Zm),z->InnerAutomorphism(Q,z));
innB:=Group(One(DefaultFieldOfMatrixGroup(maut))*
List(innB,inn->List(MPcgs,m->ExponentsOfPcElement(MPcgs,Image(inn,m)))));
tmpAut:=SubgroupNC(maut,Filtered(GeneratorsOfGroup(maut),aut->not aut in innB));
gens:=GeneratorsOfGroup(ocr.complement);
for a in GeneratorsOfGroup(tmpAut) do
imM:=List(a,i->PcElementByExponents(MPcgs,i));
imM:=GroupHomomorphismByImagesNC(Q,Q,Concatenation(MPcgs,gens),Concatenation(imM,gens));
Assert(2,IsBijective(imM));
Add(B,imM);
od;
# test condition for lifting, also add corresponding automorphism
comiso:=GroupHomomorphismByImagesNC(ocr.complement,OQ,gens,List(gens,x->ImagesRepresentative(q,x)));
precond:=fail;
mo:=GModuleByMats(LinearActionLayer(gens,MPcgs),mo.field);
cond:=function(perm)
local aut,newgens,mo2,iso,a;
if perm in Aperm then
return true;
fi;
aut:=PreImagesRepresentative(AQiso,perm);
newgens:=List(gens,x->PreImagesRepresentative(comiso,
ImagesRepresentative(aut,ImagesRepresentative(comiso,x))));
mo2:=GModuleByMats(LinearActionLayer(newgens,MPcgs),mo.field);
iso:=MTX.IsomorphismModules(mo,mo2);
if iso=fail then
return false;
else
# build associated auto
a:=GroupHomomorphismByImagesNC(Q,Q,Concatenation(gens,MPcgs),
Concatenation(newgens,
List(MPcgs,x->PcElementByExponents(MPcgs,
(ExponentsOfPcElement(MPcgs,x)*One(mo.field))*iso ))));
Assert(2,IsBijective(a));
Add(A,a);
Add(Apa,perm);
Aperm:=ClosureGroup(Aperm,perm);
return true;
fi;
end;
else
# there is no B in the nonsplit case
B:=[];
ocr:=AGSRPrepareAutomLift( Q, MPcgs, q );
precond:=function(perm)
local aut,newgens,mo2,iso,a;
if perm in Aperm then
return true;
fi;
aut:=PreImagesRepresentative(AQiso,perm);
newgens:=List(GeneratorsOfGroup(Q),
x->PreImagesRepresentative(q,Image(aut,ImagesRepresentative(q,x))));
mo2:=GModuleByMats(LinearActionLayer(newgens,MPcgs),mo.field);
return MTX.IsomorphismModules(mo,mo2)<>fail;
end;
cond:=function(perm)
local aut,newgens,mo2,iso,a;
if perm in Aperm then
return true;
fi;
aut:=PreImagesRepresentative(AQiso,perm);
newgens:=List(GeneratorsOfGroup(Q),
x->PreImagesRepresentative(q,Image(aut,ImagesRepresentative(q,x))));
mo2:=GModuleByMats(LinearActionLayer(newgens,MPcgs),mo.field);
iso:=MTX.IsomorphismModules(mo,mo2);
if iso=fail then
return false;
else
# build associated auto
a:=AGSRAutomLift(ocr,q,aut,iso);
if a=fail then
#Print("test failed\n");
return false;
else
Add(A,a);
Add(Apa,perm);
Aperm:=ClosureGroup(Aperm,perm);
#Print("test succeeded\n");
return true;
fi;
fi;
end;
fi;
# find A using the set condition
A:=[];
Apa:=[];
# note: we do not include AQI here, so might need to add later
Aperm:=SubgroupNC(AQP,List(GeneratorsOfGroup(AQI),
x->ImagesRepresentative(AQiso,x)));
# try to find some further generators
if Size(AQP)/Size(Aperm)>100 then
for j in Pcgs(RadicalGroup(AQP)) do
cond(j);
od;
for j in GeneratorsOfGroup(AQP) do
cond(j);
od;
fi;
sub:=AQP;
#if Size(KernelOfMultiplicativeGeneralMapping(hom))=1 then
# Error("trigger");
#fi;
if precond<>fail and not ForAll(GeneratorsOfGroup(sub),precond) then
sub:=SubgroupProperty(sub,precond,Aperm);
fi;
# desperately try to grab some further generators
#stablim(sub,cond,10000)=false then
#if Size(sub)/Size(Aperm)>1000000 then Error("Million"); fi;
sub:=SubgroupProperty(sub,cond,Aperm);
Aperm:=Group(Apa,());
j:=1;
while Size(Aperm)<Size(sub) do
ac:=InnerAutomorphism(OQ,Image(q,GeneratorsOfGroup(Q)[j]));
k:=ImagesRepresentative(AQiso,ac);
if not k in Aperm then
Aperm:=ClosureGroup(Aperm,k);
Add(A,InnerAutomorphism(Q,GeneratorsOfGroup(Q)[j]));
fi;
j:=j+1;
od;
Info(InfoMorph,2,"Lift Index ",Size(AQP)/Size(sub));
# now make the new automorphism group
innB:=List(SmallGeneratingSet(Q),x->InnerAutomorphism(Q,x));
gens:=ShallowCopy(innB);
Append(gens,C);
Append(gens,B);
Append(gens,A);
Assert(2,ForAll(gens,IsBijective));
for j in gens do
SetIsBijective(j,true);
od;
A:=Group(gens);
SetIsAutomorphismGroup(A,true);
SetIsGroupOfAutomorphismsFiniteGroup(A,true);
SetIsFinite(A,true);
AQI:=SubgroupNC(A,innB);
SetInnerAutomorphismsAutomorphismGroup(A,AQI);
AQ:=A;
makeaqiso();
# use the actbase for order computations
#if actbase<>fail then
# Size(A:autactbase:=List(actbase,x->Image(hom,x)));
#fi;
# do we use induced radical automorphisms to help next step?
if Size(KernelOfMultiplicativeGeneralMapping(hom))>1 and
Size(A)>10^8 and (IsAbelian(r) or AbelianRank(r)<10)
#(
## potentially large GL
#Size(GL(Length(MPcgs),RelativeOrders(MPcgs)[1]))>10^10 and
## automorphism size really grew from B/C-bit
##Size(A)/Size(AQP)*Index(AQP,sub)>10^10) )
then
if rada=fail then
if IsElementaryAbelian(r) and Size(r)>1 then
B:=Pcgs(r);
rf:=GF(RelativeOrders(B)[1]);
ind:=Filtered(ser,x->IsSubset(r,x) and Size(x)>1 and Size(x)<Size(r));
ind:=List(ind,x->List(GeneratorsOfGroup(x),y->ExponentsOfPcElement(B,y)));
ind:=List(ind,x->x*One(rf));
ind:=SpaceAndOrbitStabilizer(Length(B),rf,ind,[]);
rada:=List(GeneratorsOfGroup(ind),x->
GroupHomomorphismByImagesNC(r,r,B,List(x,y->PcElementByExponents(B,List(y,Int)))));
rada:=Group(rada);
SetIsGroupOfAutomorphismsFiniteGroup(rada,true);
NiceMonomorphism(rada:autactbase:=fail,someCharacteristics:=fail);
else
ind:=IsomorphismPcGroup(r);
rada:=AutomorphismGroup(Image(ind,r):someCharacteristics:=fail,autactbase:=fail);
# we only consider those homomorphism that stabilize the series we use
for k in List(ser,x->Image(ind,x)) do
if ForAny(GeneratorsOfGroup(rada),x->Image(x,k)<>k) then
Info(InfoMorph,3,"radical automorphism stabilizer");
NiceMonomorphism(rada:autactbase:=fail,someCharacteristics:=fail);
rada:=Stabilizer(rada,k,asAutom);
fi;
od;
# move back to bad degree
rada:=Group(List(GeneratorsOfGroup(rada),
x-> InducedAutomorphism(InverseGeneralMapping(ind),x)));
fi;
fi;
rf:=Image(hom,r);
Info(InfoMorph,2,"Use radical automorphisms for reduction");
makeaqiso();
B:=MappingGeneratorsImages(AQiso);
res:=List(B[1],x->
GroupHomomorphismByImagesNC(rf,rf,GeneratorsOfGroup(rf),
List(GeneratorsOfGroup(rf),y->ImagesRepresentative(x,y))));
ind:=[];
for j in GeneratorsOfGroup(rada) do
k:=GroupHomomorphismByImagesNC(rf,rf,
GeneratorsOfGroup(rf),
List(GeneratorsOfGroup(rf),
y->ImagesRepresentative(hom,ImagesRepresentative(j,
PreImagesRepresentative(hom,y)))));
Assert(2,IsBijective(k));
Add(ind,k);
od;
C:=Group(Concatenation(res,ind)); # to guarantee common parent
SetIsFinite(C,true);
SetIsGroupOfAutomorphismsFiniteGroup(C,true);
Size(C:autactbase:=fail,someCharacteristics:=fail); # disable autactbase transfer
res:=SubgroupNC(C,res);
ind:=SubgroupNC(C,ind);
# this should now go via the niceo of C
Size(ind:autactbase:=fail,someCharacteristics:=fail);
Size(res:autactbase:=fail,someCharacteristics:=fail);
ind:=Intersection(res,ind); # only those we care about
if Size(ind)<Size(res) then
# reduce to subgroup that induces valid automorphisms
Info(InfoMorph,1,"Radical autos reduce by factor ",Size(res)/Size(ind));
resperm:=IsomorphismPermGroup(C);
proj:=GroupHomomorphismByImagesNC(AQP,Image(resperm),
B[2],List(GeneratorsOfGroup(res),x->ImagesRepresentative(resperm,x)));
C:=PreImage(proj,Image(resperm,ind));
C:=List(SmallGeneratingSet(C),x->PreImagesRepresentative(AQiso,x));
AQ:=Group(C);
SetIsFinite(AQ,true);
SetIsGroupOfAutomorphismsFiniteGroup(AQ,true);
makeaqiso();
fi;
# # hook for using existing characteristics to reduce for next step
if somechar<>fail then
u:=Filtered(Unique(List(somechar,x->Image(hom,x))),x->Size(x)>1);
u:=Filtered(u,s->ForAny(GeneratorsOfGroup(AQ),h->Image(h,s)<>s));
SortBy(u,Size);
Info(InfoMorph,1,"Forced characteristics ",List(u,Size));
if scharorb<>fail then
# these are subgroups for which certain orbits must be stabilized.
C:=List(Reversed(scharorb),x->List(x,y->Image(hom,y)));
C:=Filtered(C,x->Size(x[1])>1 and Size(x[1])<Size(Q));
Info(InfoMorph,1,"Forced orbits ",List(C,x->Size(x[1])));
Append(u,C);
fi;
if Length(u)>0 then
C:=MappingGeneratorsImages(AQiso);
if C[2]<>GeneratorsOfGroup(AQP) then
C:=[List(GeneratorsOfGroup(AQP),
x->PreImagesRepresentative(AQiso,x)),
GeneratorsOfGroup(AQP)];
fi;
for j in u do
if IsList(j) then
# stabilizer set of subgroups
jorb:=ShallowCopy(Orbit(AQP,j[1],C[2],C[1],asAutom));
jorpo:=[Position(jorb,j[1]),Position(jorb,j[2])];
if jorpo[2]=fail then
Append(jorb,Orbit(AQP,j[1],C[2],C[1],asAutom));
jorpo[2]:=Position(jorb,j[2]);
fi;
if Length(jorb)>Length(j) then
B:=ActionHomomorphism(AQP,jorb,C[2],C[1],asAutom);
substb:=Group(List(C[2],x->ImagesRepresentative(B,x)),());
substb:=Stabilizer(substb,Set(jorpo),OnSets);
substb:=PreImage(B,substb);
Info(InfoMorph,2,"Stabilize characteristic orbit ",Size(j[1]),
" :",Size(AQP)/Size(substb) );
else
substb:=AQP;
fi;
else
substb:=Stabilizer(AQP,j,C[2],C[1],asAutom);
Info(InfoMorph,2,"Stabilize characteristic subgroup ",Size(j),
" :",Size(AQP)/Size(substb) );
fi;
if Size(substb)<Size(AQP) then
B:=Size(substb);
substb:=SmallGeneratingSet(substb);
AQP:=Group(substb);
SetSize(AQP,B);
C:=[List(substb,x->PreImagesRepresentative(AQiso,x)),substb];
fi;
od;
AQ:=Group(C[1]);
SetIsFinite(AQ,true);
SetIsGroupOfAutomorphismsFiniteGroup(AQ,true);
SetSize(AQ,Size(AQP));
#AQP:=Group(C[2]); # ensure small gen set
#SetSize(AQP,Size(AQ));
makeaqiso();
fi;
fi;
lastperm:=AQiso;
else
lastperm:=fail;
fi;
i:=i+1;
od;
return AQ;
end);
# pathetic isomorphism test, based on the automorphism group of GxH. This is
# only of use as long as we don't yet have a Cannon/Holt version of
# isomorphism available and there are many generators
InstallGlobalFunction(PatheticIsomorphism,function(G,H)
local d,a,map,possibly,cG,cH,nG,nH,i,j,sel,u,v,asAutomorphism,K,L,conj,e1,e2,
iso,api,good,gens,pre;
possibly:=function(a,b)
if Size(a)<>Size(b) then
return false;
fi;
if AbelianInvariants(a)<>AbelianInvariants(b) then
return false;
fi;
if Size(a)<1000 and Size(a)<>512
and ValueOption(NO_PRECOMPUTED_DATA_OPTION)<>true then
Info(InfoPerformance,2,"Using Small Groups Library");
if IdGroup(a)<>IdGroup(b) then
return false;
fi;
fi;
return true;
end;
asAutomorphism:=function(sub,hom)
return Image(hom,sub);
end;
# TODO: use matgrp package
if not (IsPermGroup(G) or IsPcGroup(G)) then
i:=IsomorphismPermGroup(G);
iso:=PatheticIsomorphism(Image(i,G),H);
if iso=fail then
return iso;
else
return i*iso;
fi;
fi;
# TODO: use matgrp package
if not (IsPermGroup(H) or IsPcGroup(H)) then
i:=IsomorphismPermGroup(H);
iso:=PatheticIsomorphism(G,Image(i,H));
if iso=fail then
return iso;
else
return iso*InverseGeneralMapping(i);
fi;
fi;
# go through factors of characteristic series to keep orbits short.
AutomorphismGroup(G:someCharacteristics:=fail);
AutomorphismGroup(H:someCharacteristics:=fail);
cG:=CharacteristicSubgroups(G);
nG:=[];
cH:=ShallowCopy(CharacteristicSubgroups(H));
if Length(cG)<>Length(cH) then
return fail;
fi;
SortBy(cH,Size);
nH:=[];
i:=1;
good:=[1..Length(cH)];
while i<=Length(cH) do
if i in good and Size(cH[i])>1 and Size(cH[i])<Size(H) then
sel:=Filtered([1..Length(cG)],x->possibly(cG[x],cH[i]));
if Length(sel)=0 then
return fail;
elif Length(sel)=1 then
Add(nG,cG[sel[1]]);
Add(nH,cH[i]);
else
u:=TrivialSubgroup(G);
for j in sel do
u:=ClosureGroup(u,cG[j]);
od;
sel:=Concatenation([i],Filtered([i+1..Length(cH)],
x->possibly(cH[i],cH[x])));
v:=TrivialSubgroup(H);
for j in sel do
v:=ClosureGroup(v,cH[j]);
od;
if Size(u)<>Size(v) then
return fail;
fi;
good:=Difference(good,sel);
if Size(u)<Size(G) then
Add(nG,u);
Add(nH,v);
fi;
fi;
fi;
i:=i+1;
od;
d:=DirectProduct(G,H);
e1:=Embedding(d,1);
e2:=Embedding(d,2);
# combine images of characteristic factors, reverse order
cG:=[];
nG:=Reversed(nG);
nH:=Reversed(nH);
for i in [1..Length(nG)] do
Add(cG,ClosureGroup(Image(e1,nG[i]),Image(e2,nH[i])));
od;
nG:=Concatenation([TrivialSubgroup(G)],nG);
nH:=Concatenation([TrivialSubgroup(H)],nH);
for i in [2..Length(nG)] do
K:=Filtered([1..Length(nG)],x->Size(nG[x])*2=Size(nG[i])
and IsSubset(nG[i],nG[x]));
if Length(K)>0 then
K:=K[1];
# We are seeking an isomorphism, not the full automorphism group of
# GxG. It is thus sufficient, if we find the subgroup Aut(G)\wr 2.
# We now found that G and H have two characteristic subgroups A<B with
# [B:A]=2. An isomorphism swapping G and H will need to map B to B and
# A to A. Furthermore, in the factor modulo A_G xA_H, a generator of
# B_G must be swappes with a generator of B_H.
# This implies that A_G\times A_H, together with the diagonal of B is
# characteristic in Aut(A)\wr 2. We thus may add this subgroup as
# ``characteristic'' to improve the series.
Add(cG,ClosureGroup(
ClosureGroup(Image(e1,nG[K]),Image(e2,nH[K])),
Image(e1,First(GeneratorsOfGroup(nG[i]),x->not x in nG[K]))
*Image(e2,First(GeneratorsOfGroup(nH[i]),x->not x in nH[K]))));
fi;
od;
K:=[Image(e1,G),Image(e2,H)];
# we also fix the *pairs* of the characteristic subgroups as orbits. Again
# this must happen in Aut(G)\wr 2, and reduces the size of the group.
a:=AutomorphismGroup(d:autactbase:=K,someCharacteristics:=
rec(subgroups:=cG,
orbits:=List([1..Length(nG)],x->[Image(e1,nG[x]),Image(e2,nH[x])])));
iso:=IsomorphismPermGroup(a:autactbase:=K);
api:=Image(iso);
#if NrMovedPoints(api)>5000 then
# K:=SmallerDegreePermutationRepresentation(api);
# Info(InfoMorph,2,"Permdegree reduced ",
# NrMovedPoints(api),"->",NrMovedPoints(Image(K)));
# iso:=iso*K;
# api:=Image(iso);
# fi;
# now work in reverse through the characteristic factors
conj:=One(a);
K:=Image(e1,G);
L:=Image(e2,H);
Add(cG,TrivialSubgroup(d));
for i in cG do
u:=ClosureGroup(i,K);
v:=ClosureGroup(i,L);
if u<>v then
if IsSolvableGroup(api) then
gens:=Pcgs(api);
else
gens:=SmallGeneratingSet(api);
fi;
pre:=List(gens,x->PreImagesRepresentative(iso,x));
map:=RepresentativeAction(SubgroupNC(a,pre),u,v,asAutomorphism);
if map=fail then
return fail;
fi;
conj:=conj*map;
K:=Image(map,K);
u:=Stabilizer(api,v,gens,pre,asAutomorphism);
Info(InfoMorph,1,"Factor ",Size(d)/Size(i),": ",
"reduce by ",Size(api)/Size(u));
api:=u;
fi;
od;
return GroupHomomorphismByImagesNC(G,H,GeneratorsOfGroup(G),
List(GeneratorsOfGroup(G),x->PreImagesRepresentative(e2,
Image(conj,Image(e1,x)))));
end);