|
#############################################################################
##
## This file is part of GAP, a system for computational discrete algebra.
## This file's authors include 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 methods for orbits on subgroups
##
#############################################################################
##
#M GroupOnSubgroupsOrbit(G,H) . . . . . . . . . . . . . . orbit of H under G
##
InstallGlobalFunction( GroupOnSubgroupsOrbit, function(G,H)
return Enumerator(ConjugacyClassSubgroups(G,H));
end );
#############################################################################
##
#M MinimumGroupOnSubgroupsOrbit(G,H [,N_G(H)]) minimum of orbit of H under G
##
InstallGlobalFunction( MinimumGroupOnSubgroupsOrbit, function(arg)
local cont,lim,s,i,j,m,Hc,o;
# try some orbit calculation first (at most orbit of length 20) to avoid
# normalizer calculations.
cont:=true;
lim:=QuoInt(Size(arg[1]),Size(arg[2]));
if lim>20 then
cont:=lim<200000; # otherwise give up at once
lim:=20;
fi;
if cont then
o:=[arg[2]];
else
o:=[];
fi;
m:=arg[2];
i:=1;
while cont and i<=Length(o) do
for j in GeneratorsOfGroup(arg[1]) do
if not ForAny(o,x->ForAll(GeneratorsOfGroup(o[i]),y->y^j in x)) then
Hc:=o[i]^j;
Add(o,Hc);
if Hc<m then
m:=Hc;
fi;
cont:=Length(o)<lim;
fi;
od;
i:=i+1;
od;
if not cont then
# orbit is longer -- have to work
s:=ConjugacyClassSubgroups(arg[1],arg[2]);
if Length(arg)>2 then
SetStabilizerOfExternalSet(s,arg[3]);
fi;
s:=Enumerator(s);
if Length(s)>2*lim then
o:=[]; # the orbit is not worth keeping -- test would be too expensive
fi;
for i in [1..Length(s)] do
Hc:=s[i];
if not ForAny(o,x->ForAll(GeneratorsOfGroup(Hc),y-> y in x)) then
if Hc<m then
m:=Hc;
fi;
fi;
od;
fi;
return m;
end );
InstallMethod(SubgroupsOrbitsAndNormalizers,"generic on list",true,
[IsGroup,IsList,IsBool],0,
function(G,dom,all)
local n,l,o,b,r,p,cl,i,sel,selz,gens,ti,t,tl;
n:=Length(dom);
l:=n;
o:=[];
b:=BlistList([1..l],[1..n]);
while n>0 do
p:=Position(b,true);
b[p]:=false;
n:=n-1;
r:=rec(representative:=dom[p],pos:=p);
cl:=ConjugacyClassSubgroups(G,r.representative);
gens:=GeneratorsOfGroup(r.representative);
r.normalizer:=StabilizerOfExternalSet(cl);
t:=RightTransversal(G,r.normalizer);
tl:=Length(t);
sel:=Filtered([1..l],i->b[i]);
selz:=Filtered(sel,i->Size(dom[i])=Size(r.representative));
if Length(selz)>0 then
i:=1;
while Length(sel)>0 and i<=tl do;
ti:=t[i];
p:=PositionProperty(sel,
j->j in selz and ForAll(gens,k->k^ti in dom[j]));
if p<>fail then
p:=sel[p];
b[p]:=false;
n:=n-1;
RemoveSet(sel,p);
fi;
i:=i+1;
od;
fi;
if all then
cl:=Enumerator(cl);
r.elements:=cl;
fi;
Add(o,r);
od;
return o;
end);
# prepare list of subgroups of a permgroup G for conjugacy test and cluster
# accordingly. returns list with entries
# clusters (index lists)
# actors (for each cluster the subgroup that is still acting. Set to trivial
# if groups are fully conjugated)
# gps (groups already conjugates so the action is reduced to acts for each
# cluster)
# conjugators (for subgroups in list, elements conjugationg to gps)
# normalizers: if not `false` normalizers of cluster rep in gps
#
# Another orbit algorithm variant...
BindGlobal("CCPOSA",function(G,p,q,act)
local o,s,rep,i,j,img,pos;
o:=[p];
s:=TrivialSubgroup(G);
rep:=[One(G)];
i:=1;
while i<=Length(o) do
for j in GeneratorsOfGroup(G) do
img:=act(o[i],j);
pos:=Position(o,img);
if pos=fail then
Add(o,img);
Add(rep,rep[i]*j);
else
s:=ClosureSubgroupNC(s,rep[i]*j/rep[pos]);
fi;
od;
i:=i+1;
od;
pos:=Position(o,q);
if pos=fail then return fail;
else return [s,rep[pos]];fi;
end);
InstallGlobalFunction(ClusterConjugacyPermgroups,function(G,l)
local acts,gps,clusters,conj,ncl,nacts,i,j,new,q,hom,lhom,c,n,r,len,
pat,oa,ob,orbs,k,gens,nnors,m,kk,perm,fur,ooa,oob,lan,subset,localn;
acts:=[G];
gps:=ShallowCopy(l);
subset:=ForAll(l,x->IsSubset(G,x));
clusters:=[[1..Length(gps)]];
conj:=List(gps,x->One(G));
# orders
ncl:=[];
nacts:=[];
for i in [1..Length(clusters)] do
new:=Set(List(gps{clusters[i]},Size));
for q in new do
c:=Filtered(clusters[i],x->Size(gps[x])=q);
Add(ncl,c);
Add(nacts,acts[i]);
od;
od;
clusters:=ncl;
acts:=nacts;
# find a homomorphism (already existing)
hom:=fail;
c:=NaturalHomomorphismsPool(G);
new:=Filtered([1..Length(c.ker)],
x->IsMapping(c.ops[x]) and c.cost[x]<NrMovedPoints(G));
q:=Difference(List(c.ker{new},Size),[1,Size(G)]);
if Length(q)>0 then
q:=Minimum(q);
q:=First(new,x->Size(c.ker[x])=q);
hom:=c.ops[q];
fi;
if hom<>fail then # work in factor
if Size(Source(hom))>Size(G) then
hom:=RestrictedMapping(hom,G);
fi;
Info(InfoLattice,5,"Factor: ",Size(Range(hom)),"/",
Size(KernelOfMultiplicativeGeneralMapping(hom)));
ncl:=[];
nacts:=[];
for i in [1..Length(clusters)] do
if Size(Source(hom))=Size(acts[i]) then
lhom:=hom;
else
lhom:=RestrictedMapping(hom,acts[i]);
fi;
c:=clusters[i];
q:=Image(lhom,acts[i]);
m:=List(c,x->Image(lhom,gps[x]));
new:=ClusterConjugacyPermgroups(q,m);
new:=RefineClusterConjugacyPermgroups(new);
for j in [1..Length(new.clusters)] do
Add(ncl,c{new.clusters[j]});
if new.normalizers[j]<>false then
n:=new.normalizers[j];
else
n:=new.actors[j];
fi;
Info(InfoLattice,5,"reduced (factor) by ",Size(q)/Size(n));
Add(nacts,PreImage(lhom,n));
for k in new.clusters[j] do
r:=PreImagesRepresentative(lhom,new.conjugators[k]);
conj[c[k]]:=conj[c[k]]*r;
gps[c[k]]:=gps[c[k]]^r;
od;
od;
od;
clusters:=ncl;
acts:=nacts;
fi;
# same orbits
ncl:=[];
nacts:=[];
for i in [1..Length(clusters)] do
c:=clusters[i];
q:=MovedPoints(acts[i]);
orbs:=[];
for j in c do
orbs[j]:=List(Orbits(gps[j],q),Set);
od;
while Length(c)>0 do
new:=[c[1]];
pat:=Collected(List(orbs[c[1]],Length));
len:=List(pat,x->x[1]);
# TODO: Wreath
oa:=List(len,x->Union(Filtered(orbs[c[1]],y->Length(y)=x)));
perm:=Sortex(List(oa,Length));
oa:=Permuted(oa,perm);
len:=Permuted(len,perm);
n:=[acts[i]];
for j in oa do
q:=Last(n);
if ForAny(GeneratorsOfGroup(q),x->OnSets(j,x)<>j) then
q:=Stabilizer(q,j,OnSets);
fi;
Add(n,q);
od;
lan:=Last(n);
fur:=Length(Orbits(lan,MovedPoints(acts[i])))
<>Length(orbs[c[1]]);
localn:=[Last(n)];
if Size(lan)=Size(acts[i]) and not fur then
# already all the same
Add(ncl,c);
Add(nacts,acts[i]);
c:=[];
else
Info(InfoLattice,5,"reduced (orb) by ",Size(acts[i])/Size(Last(n)));
for j in [2..Length(c)] do
localn:=[Last(n)];
if Collected(List(orbs[c[j]],Length))=pat then
r:=One(acts[i]);
# already for changed len!
ob:=List(len,x->Union(Filtered(orbs[c[j]],y->Length(y)=x)));
# first gets sets unions OK.
for k in [1..Length(oa)] do
if r<>fail then
q:=RepresentativeAction(n[k],ob[k],oa[k],OnSets);
if q=fail then r:=fail;
else
r:=r*q;
for kk in [k+1..Length(oa)] do
ob[kk]:=OnSets(ob[kk],q);
od;
fi;
fi;
od;
# record we already changed the groups to have same orbits
if r<>fail then
q:=c[j];
conj[q]:=conj[q]*r;
gps[q]:=gps[q]^r;
orbs[q]:=OnTuplesSets(orbs[q],r);
fi;
# and now sets therein
if fur then
r:=();
for k in [1..Length(oa)] do
if r<>fail then
ooa:=Set(Filtered(orbs[c[1]],y->Length(y)=len[k]));
oob:=Set(List(Filtered(orbs[c[j]],y->Length(y)=len[k])),
x->OnSets(x,r));
if ooa<>oob then
q:=CCPOSA(localn[k],ooa,oob,OnSetsSets);
if q=fail then r:=fail;
else
Add(localn,q[1]); # partition stabilizer
q:=q[2]^-1; # mapping oob to ooa
r:=r*q;
fi;
else
Add(localn,Stabilizer(Last(localn),ooa,OnSetsSets));
fi;
fi;
od;
# record further orbit move
if r<>fail then
q:=c[j];
conj[q]:=conj[q]*r;
gps[q]:=gps[q]^r;
orbs[q]:=OnTuplesSets(orbs[q],r);
fi;
fi;
if r<>fail then
q:=c[j];
Add(new,q);
fi;
fi;
od;
Add(ncl,new);
Add(nacts,Last(localn));
c:=Difference(c,new);
fi;
od;
od;
clusters:=ncl;
acts:=nacts;
# small enough index
ncl:=[];
nacts:=[];
nnors:=[];
for i in [1..Length(clusters)] do
c:=clusters[i];
if Length(c)=1 or Size(acts[i])/Size(gps[c[1]])>1000 then
Add(ncl,c);
Add(nacts,acts[i]);
Add(nnors,false); # no normalizer computed
elif Size(acts[i])=Size(gps[c[1]]) then
Add(ncl,c);
Add(nacts,acts[i]);
Add(nnors,acts[i]); # no normalizer computed
else
Info(InfoLattice,5,"reduced (transversal) by ",Size(acts[i])/Size(gps[c[1]]));
while Length(c)>0 do
n:=gps[c[1]];
ob:=n;
gens:=GeneratorsOfGroup(n);
if HasSolvableRadical(acts[i]) then
k:=Filtered([1..Length(gens)],x->gens[x] in SolvableRadical(acts[i]));
gens:=gens{Concatenation(Difference([1..Length(gens)],k),k)};
fi;
new:=[c[1]];
c:=c{[2..Length(c)]};
if subset then
oa:=RightTransversal(acts[i],n);
else
n:=Normalizer(acts[i],n);
oa:=RightTransversal(acts[i],n);
fi;
k:=1;
while k<=Length(oa) do
r:=oa[k];
if (not r in n) and ForAll(gens,x->x^r in ob) then
n:=ClosureGroup(n,r);
fi;
for j in c do
if ForAll(gens,x->x^r in gps[j]) then # same size
Add(new,j);
c:=Difference(c,[j]);
conj[j]:=conj[j]/r;
gps[j]:=ob;
fi;
od;
k:=k+1;
od;
Add(ncl,new);
Add(nacts,fail);
nnors[Length(ncl)]:=n;
od;
fi;
od;
clusters:=ncl;
acts:=nacts;
for i in [1..Length(clusters)] do
c:=clusters[i][1];
# was leading group conjugated away before -- conjugate back?
r:=conj[c];
if not IsOne(r) then
r:=r^-1;
for j in clusters[i] do
gps[j]:=gps[j]^r;
conj[j]:=conj[j]*r;
od;
if nnors[i]<>false then
nnors[i]:=nnors[i]^r;
fi;
if acts[i]<>fail then
acts[i]:=acts[i]^r;
fi;
fi;
od;
# check
Assert(1,ForAll([1..Length(clusters)],x->IsOne(conj[clusters[x][1]])));
Assert(1,ForAll([1..Length(clusters)],i->acts[i]<>fail or
ForAll([2..Length(clusters[i])],j->gps[clusters[i][1]]=gps[clusters[i][j]])));
Assert(2,ForAll([1..Length(l)],x->l[x]^conj[x]=gps[x]));
Assert(2, subset=false or ForAll([1..Length(nnors)],i->acts[i]=fail
or IsSubset(acts[i],Normalizer(G,l[clusters[i][1]]))));
Assert(2, subset=false or ForAll([1..Length(nnors)],i->nnors[i]=false
or nnors[i]=Normalizer(G,l[clusters[i][1]])));
for i in [1..Length(clusters)] do
for j in [i+1..Length(clusters)] do
Assert(3,RepresentativeAction(G,l[clusters[i][1]],
l[clusters[j][1]])=fail);
od;
od;
return rec(
clusters:=clusters,
actors:=acts,
conjugators:=conj,
gps:=gps,
normalizers:=nnors
);
end);
InstallGlobalFunction(RefineClusterConjugacyPermgroups,function(A)
local acts,nacts,clusters,ncl,c,conj,gps,nors,nnors,i,j,r,n,new;
acts:=A.actors;
clusters:=A.clusters;
conj:=ShallowCopy(A.conjugators);
gps:=ShallowCopy(A.gps);
nors:=A.normalizers;
nacts:=[];
ncl:=[];
nnors:=[];
for i in [1..Length(clusters)] do
c:=clusters[i];
if Length(c)=1 or ForAll([2..Length(c)],x->gps[c[1]]=gps[c[x]]) then
# all groups in cluster are already the same
Add(ncl,c);
Add(nacts,acts[i]);
if nors[i]=false then
if acts[i]=gps[c[1]] then
Add(nnors,gps[c[1]]); # do not duplicate the acts, but the subgroup
else
Add(nnors,Normalizer(acts[i],gps[c[1]]));
fi;
else
Add(nnors,nors[i]);
fi;
else
# need to do hard conjugacy tests
while Length(c)>0 do
new:=[c[1]];
n:=Normalizer(acts[i],gps[c[1]]);
for j in [2..Length(c)] do
r:=ConjugatorPermGroup(acts[i],gps[c[j]],gps[c[1]]);
if r<>fail then
Add(new,c[j]);
conj[c[j]]:=conj[c[j]]*r;
gps[c[j]]:=gps[c[j]]^r;
fi;
od;
c:=Difference(c,new);
Add(ncl,new);
Add(nacts,n);
Add(nnors,n);
od;
fi;
od;
return rec(
clusters:=ncl,
actors:=nacts,
conjugators:=conj,
gps:=gps,
normalizers:=nnors
);
end);
InstallMethod(SubgroupsOrbitsAndNormalizers,"perm group on list",true,
[IsPermGroup,IsList,IsBool],0,
function(G,dom,all)
local n,l, o, b, t, r,sub;
if Length(dom)=0 then
return dom;
elif Length(dom)=1 then
return [rec(pos:=1,
representative:=dom[1],
normalizer:=Normalizer(G,dom[1]))];
fi;
# new code -- without `all` option
n:=Length(dom);
sub:=ForAll(dom,x->IsSubset(G,x));
if n>20 and sub and NrMovedPoints(G)>1000 then
#and NrMovedPoints(G)*1000>Size(G) then
b:=SmallerDegreePermutationRepresentation(G:cheap);
if NrMovedPoints(Range(b))*13/10<NrMovedPoints(G) then
l:=SubgroupsOrbitsAndNormalizers(Image(b,G),
List(dom,x->Image(b,x)),all);
dom:=List(l,x->rec(pos:=x.pos,normalizer:=PreImage(b,x.normalizer),
representative:=dom[x.pos]));
return dom;
fi;
fi;
if not sub then TryNextMethod();fi;
l:=ClusterConjugacyPermgroups(G,ShallowCopy(dom));
l:=RefineClusterConjugacyPermgroups(l);
o:=[];
for b in [1..Length(l.clusters)] do
t:=l.clusters[b];
r:=rec(representative:=dom[t[1]],pos:=t[1]);
n:=l.normalizers[b];
if n=false then
if Size(l.actors[b])=Size(r.representative) then
n:=r.representative;
else
n:=Normalizer(l.actors[b]^(l.conjugators[t[1]]^-1),r.representative);
fi;
else
n:=n^(l.conjugators[t[1]]^-1);
fi;
r.normalizer:=n;
Add(o,r);
od;
return o;
end);
InstallMethod(SubgroupsOrbitsAndNormalizers,"pc group on list",true,
[IsPcGroup,IsList,IsBool],0,
function(G,dom,all)
local n,l,o,b,r,p,cl,i,sel,selz,allcano,cano,can2,p1;
allcano:=[];
n:=Length(dom);
l:=n;
o:=[];
b:=BlistList([1..l],[1..n]);
while n>0 do
p:=Position(b,true);
p1:=p;
b[p]:=false;
n:=n-1;
r:=rec(representative:=dom[p],pos:=p);
sel:=Filtered([1..l],i->b[i]);
selz:=Filtered(sel,i->Size(dom[i])=Size(r.representative));
if Length(selz)>0 then
if IsBound(allcano[p1]) then
cano:=allcano[p1];
else
cano:=CanonicalSubgroupRepresentativePcGroup(G,r.representative);
fi;
r.normalizer:=ConjugateSubgroup(cano[2],cano[3]^-1);
cano:=cano[1];
for i in selz do
if IsBound(allcano[i]) then
can2:=allcano[i];
else
can2:=CanonicalSubgroupRepresentativePcGroup(G,dom[i]);
fi;
if can2[1]=cano then
b[i]:=false;
n:=n-1;
RemoveSet(sel,i);
Unbind(allcano[i]);
else
allcano[i]:=can2;
fi;
od;
else
r.normalizer:=Normalizer(G,r.representative);
fi;
if all then
cl:=ConjugacyClassSubgroups(G,r.representative);
SetStabilizerOfExternalSet(cl,r.normalizer);
r.elements:=Enumerator(cl);
fi;
Add(o,r);
Unbind(allcano[p1]);
od;
return o;
end);
# destructive version
# this method takes the component 'list' from the record and shrinks the
# list to save memory
InstallMethod(SubgroupsOrbitsAndNormalizers,"generic on record with list",true,
[IsGroup,IsRecord,IsBool],0,
function(G,r,all)
local n,o,dom,cl,i,s,j,t,ti,tl,gens;
dom:=r.list;
Unbind(r.list);
n:=Length(dom);
o:=[];
while n>0 do
r:=rec(representative:=dom[1]);
gens:=GeneratorsOfGroup(dom[1]);
s:=Size(dom[1]);
cl:=ConjugacyClassSubgroups(G,r.representative);
r.normalizer:=StabilizerOfExternalSet(cl);
cl:=Enumerator(cl);
t:=RightTransversal(G,r.normalizer);
tl:=Length(t);
i:=1;
while i<=tl and Length(dom)>0 do
ti:=t[i];
j:=2;
while j<=Length(dom) do
if Size(dom[j])=s and ForAll(gens,k->k^ti in dom[j]) then
# hit
dom[j]:=Last(dom);
Remove(dom);
else
j:=j+1;
fi;
od;
i:=i+1;
od;
if all then
r.elements:=cl;
fi;
Add(o,r);
od;
return o;
end);
#############################################################################
##
#M StabilizerOp( <G>, <D>, <subgroup>, <U>, <V>, <OnPoints> )
##
## subgroup stabilizer
InstallMethod( StabilizerOp, "with domain, use normalizer", true,
[ IsGroup, IsList, IsGroup, IsList, IsList, IsFunction ],
# raise over special methods for pcgs et. al.
200,
function( G, D, sub, U, V, op )
if not U=V or op<>OnPoints then
TryNextMethod();
fi;
return Normalizer(G,sub);
end );
InstallOtherMethod( StabilizerOp, "use normalizer", true,
[ IsGroup, IsGroup, IsList, IsList, IsFunction ],
# raise over special methods for pcgs et. al.
200,
function( G, sub, U, V, op )
if not U=V or op<>OnPoints then
TryNextMethod();
fi;
return Normalizer(G,sub);
end );
InstallGlobalFunction(PermPreConjtestGroups,function(G,l)
local pats,spats,lpats,result,pa,lp,lens,h,orbs,p,rep,cln,allorbs,
allco,panu,gpcl,i,j,k,Gm,a,corbs,dict,norb,m,ornums,sornums,
ssornums,sel,sela,statra,lrep,gpcl2,je,lrep1,partimg,nobail,cnt,hpos;
if not IsPermGroup(G) then
return [[G,l]];
fi;
pats:=List(l,x->Collected(List(Orbits(x,MovedPoints(x)),Length)));
spats:=Set(pats);
Info(InfoLattice,2,Length(spats)," patterns");
result:=[];
for pa in [1..Length(spats)] do
lp:=Filtered([1..Length(pats)],x->pats[x]=spats[pa]);
lp:=l{lp};
Info(InfoLattice,3,"Pattern ",pa,": ",Length(lp)," groups");
lens:=List(spats[pa],x->x[1]);
# now try to move the orbits always to the same
allorbs:=[];
allco:=[];
panu:=0;
gpcl:=[];
for h in lp do
orbs:=Orbits(h,MovedPoints(h));
orbs:=List(lens,x->Union(Filtered(orbs,y->Length(y)=x)));
p:=Position(allorbs,orbs);
if p<>fail then
rep:=allco[p][1];
cln:=allco[p][2];
else
Add(allorbs,orbs);
# try to map to a known one
j:=1;
while j<>fail and j<Length(allorbs) do
if orbs=allorbs[j] then
rep:=One(G);
else
Gm:=G;
rep:=One(G);
corbs:=List(orbs,ShallowCopy);
for k in [1..Length(orbs)] do
if rep<>fail then
a:=RepresentativeAction(Gm,corbs[k],allorbs[j][k],OnSets);
if a<>fail then
rep:=rep*a;
corbs:=List(corbs,x->OnSets(x,a));
Gm:=Stabilizer(Gm,allorbs[j][k],OnSets);
else
rep:=fail;
fi;
fi;
od;
fi;
if rep<>fail then
# found a conjugator -- join to class
cln:=allco[j][2];
Add(allco,[rep,cln]);
j:=fail;
else
j:=j+1;
fi;
od;
if j<>fail then
# none found -- new class
panu:=panu+1;
Add(allco,[One(G),panu]);
Gm:=G;
for k in orbs do
Gm:=Stabilizer(Gm,k,OnSets);
od;
Add(gpcl,[Gm,[]]);
cln:=panu;
rep:=One(G);
fi;
fi;
h:=h^rep;
Add(gpcl[cln][2],h);
od;
Info(InfoLattice,3,Length(gpcl)," orbit lengths classes ");
Info(InfoLattice,5,List(gpcl,x->Length(x[2])));
# split according to orbits. First orbits as they are orbits under j[1],
# then as partitions.
panu:=[];
for j in gpcl do
if Length(j[2])=1 then
Add(panu,j);
else
allorbs:=[];
lpats:=[];
cnt:=Minimum(1000,Binomial(Length(j[2]),2)); # pairs
nobail:=true;
dict:=NewDictionary(MovedPoints(j[1]),true);
norb:=0;
hpos:=1;
while nobail and hpos<=Length(j[2]) do
h:=j[2][hpos];
orbs:=Set(Orbits(h,MovedPoints(h)),Set);
MakeImmutable(orbs);List(orbs,IsSet);IsSet(orbs);
lp:=[];
for k in orbs do
rep:=LookupDictionary(dict,k);
if nobail and rep=fail then
a:=Orbit(j[1],k,OnSets);
cnt:=cnt-Length(a);
if cnt<0 then
nobail:=false; # stop this orbit listing as too expensive.
else
MakeImmutable(a);List(a,IsSet);
norb:=norb+1;
rep:=norb;
for m in a do
AddDictionary(dict,m,norb);
od;
fi;
fi;
Add(lp,rep);
od;
Sort(lp); # orbit pattern as numbers
rep:=Position(allorbs,lp);
if rep=fail then
Add(allorbs,lp);
Add(lpats,[j[1],[h]]);
else
Add(lpats[rep][2],h);
fi;
hpos:=hpos+1;
od;
if nobail then
# now lpats are local patterns, but we still have the dictionary to
# make the orbit conjugation tests cheaper.
gpcl2:=lpats;
for je in gpcl2 do
if Length(je[2])=1 then
Add(panu,je);
else
allorbs:=[];
lpats:=[];
for h in je[2] do
orbs:=Set(Orbits(h,MovedPoints(h)),Set);
MakeImmutable(orbs);List(orbs,IsSet);IsSet(orbs);
ornums:=List(orbs,x->LookupDictionary(dict,x));
sornums:=ShallowCopy(ornums);Sort(sornums);
ssornums:=Set(sornums);
a:=Filtered([1..Length(allorbs)],x->allorbs[x][2]=sornums);
rep:=fail;
k:=0;
while rep=fail and k<Length(a) do
k:=k+1;
lrep:=One(je[1]);
m:=1;
while lrep<>fail and m<=Length(ssornums) do
sel:=Filtered([1..Length(ornums)],x->ornums[x]=ssornums[m]);
sela:=Filtered([1..Length(ornums)],
x->allorbs[k][4][x]=ssornums[m]);
partimg:=OnSetsSets(orbs{sel},lrep^-1);
# only try to map these indexed orbits
if allorbs[k][1]{sela}=partimg then
lrep1:=One(je[1]);
elif Size(allorbs[k][5][m][1])/
Size(allorbs[k][5][m+1][1])>50 then
if allorbs[k][5][m][2]=0 then
# delayed transversal
allorbs[k][5][m][2]:=
RightTransversal(allorbs[k][5][m][1],
allorbs[k][5][m+1][1]);
fi;
lrep1:=First(allorbs[k][5][m][2],
x->OnSetsSets(allorbs[k][1]{sela},x)=partimg);
else
lrep1:=RepresentativeAction(allorbs[k][5][m][1],
allorbs[k][1]{sela},partimg,OnSetsSets);
fi;
if lrep1=fail then
lrep:=fail;
else
lrep:=lrep1*lrep;
fi;
m:=m+1;
od;
rep:=lrep;
od;
if rep=fail then
a:=je[1];
statra:=[];
for m in ssornums do
sel:=Filtered([1..Length(ornums)],x->ornums[x]=m);
Add(statra,[a,0]); # 0 is delayed transversal
a:=Stabilizer(a,orbs{sel},OnSetsSets);
od;
Add(statra,[a,0]);
Add(allorbs,[orbs,sornums,a,ornums,statra]);
Add(lpats,[a,[h]]);
else
Add(lpats[k][2],h^(rep^-1));
fi;
od;
Append(panu,lpats);
fi;
od;
else
# if bailed
Add(panu,j);
fi;
fi;
od;
gpcl:=panu;
Info(InfoLattice,3,Length(gpcl)," orbit classes ");
Info(InfoLattice,5,List(gpcl,x->Length(x[2])));
# now split by cycle structures
panu:=[];
for j in gpcl do
if Size(j[2][1])<1000 then
if Size(j[2][1])<=100 or IsAbelian(j[2][1]) then
allorbs:=List(j[2],x->Collected(List(Enumerator(x),CycleStructurePerm)));
else
allorbs:=List(j[2],x->Collected(List(ConjugacyClasses(x),
y->Concatenation([Size(y)],
CycleStructurePerm(Representative(y))))));
fi;
allco:=Set(allorbs);
for k in allco do
a:=Filtered([1..Length(allorbs)],x->allorbs[x]=k);
orbs:=[];
for i in j[2]{a} do
if not ForAny(orbs,x->ForAll(GeneratorsOfGroup(i),y->y in x)) then
Add(orbs,i);
fi;
od;
Add(result,[j[1],orbs]);
Add(panu,Length(orbs));
od;
else
Add(result,j);
Add(panu,1);
fi;
od;
Info(InfoLattice,3," to ",Length(panu)," cyclestruct classes ");
od;
return result;
end);
[ Dauer der Verarbeitung: 0.32 Sekunden
(vorverarbeitet)
]
|
