From 0d5f49e093edb0ab7c8fa811b9cb97edf758d942 Mon Sep 17 00:00:00 2001 From: Alexander Hulpke Date: Thu, 26 Nov 2020 13:09:35 -0700 Subject: [PATCH 1/7] ENHANCE: Added CompositionSeriesThrough --- lib/grp.gd | 8 +++++++- lib/grp.gi | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 65 insertions(+), 1 deletion(-) diff --git a/lib/grp.gd b/lib/grp.gd index 81b34ce913..8e4f17ec82 100644 --- a/lib/grp.gd +++ b/lib/grp.gd @@ -1035,20 +1035,26 @@ DeclareAttribute( "CommutatorFactorGroup", IsGroup ); ############################################################################# ## #A CompositionSeries( ) +#A CompositionSeriesThrough( , ) ## ## <#GAPDoc Label="CompositionSeries"> ## ## +## ## ## ## A composition series is a subnormal series which cannot be refined. ## This attribute returns one composition series (of potentially many -## possibilities). +## possibilities). The variant takes +## as second argument a list normals of normal subgroups of the +## group, and returns a composition series that incorporates these normal +## subgroups. ## ## ## <#/GAPDoc> ## DeclareAttribute( "CompositionSeries", IsGroup ); +DeclareOperation( "CompositionSeriesThrough", [IsGroup,IsList] ); #T and for module? diff --git a/lib/grp.gi b/lib/grp.gi index 18746dd812..adc901d1b6 100644 --- a/lib/grp.gi +++ b/lib/grp.gi @@ -939,6 +939,64 @@ InstallMethod( CompositionSeries, "for simple group", true, [IsGroup and IsSimpleGroup], 100, S->[S,TrivialSubgroup(S)]); +InstallMethod(CompositionSeriesThrough,"intersection/union",IsElmsColls, + [IsGroup and IsFinite,IsList],0, +function(G,normals) +local cs,i,j,pre,post,c,new,rev; + cs:=CompositionSeries(G); + # find normal subgroups not yet in + normals:=Filtered(normals,x->not x in cs); + # do we satisfy by sheer dumb luck? + if Length(normals)=0 then return cs;fi; + + SortBy(normals,x->-Size(x)); + # check that this is a valid series + Assert(0,ForAll([2..Length(normals)],i->IsSubset(normals[i-1],normals[i]))); + + # Now move series through normals by closure/intersection + for j in normals do + # first in cs that does not contain j + pre:=PositionProperty(cs,x->not IsSubset(x,j)); + # first contained in j. + post:=PositionProperty(cs,x->Size(j)>=Size(x) and IsSubset(j,x)); + + # if j is in the series, then pre>post. pre=post impossible + if preSize(rev[Length(rev)]) then + # proper down step + Add(rev,c); + fi; + fi; + i:=i-1; + # at some point this must reach j, then no further step needed + until Size(c)=Size(cs[pre-1]) or iSize(x) Date: Wed, 18 Nov 2020 13:15:44 -0700 Subject: [PATCH 2/7] ENHANCE: Performance improvements generic 2-cohomology - Speed up collection process for 2-cohomology - If factor permrep is large, do first try for stabilizer - when computing permdegree, avoid the bold first attempt to be too bad. --- lib/twocohom.gi | 127 ++++++++++++++++++++++++++++++------------------ 1 file changed, 81 insertions(+), 46 deletions(-) diff --git a/lib/twocohom.gi b/lib/twocohom.gi index 16430bd1f9..8125736e04 100644 --- a/lib/twocohom.gi +++ b/lib/twocohom.gi @@ -708,7 +708,7 @@ local field,fp,fpg,gens,hom,mats,fm,mon,kb,tzrules,dim,rules,eqs,i,j,k,l,o,l1, len1,l2,m,start,formalinverse,hastail,one,zero,new,v1,v2,collectail, findtail,colltz,mapped,mapped2,onemat,zerovec,dict,max,mal,s,p,genkill, c,nvars,htpos,zeroq,r,ogens,bds,model,q,pre,pcgs,miso,ker,solvec,rulpos, - nonone,predict,lenpre; + nonone,predict,lenpre,jv; # collect the word in factor group @@ -725,17 +725,16 @@ local field,fp,fpg,gens,hom,mats,fm,mon,kb,tzrules,dim,rules,eqs,i,j,k,l,o,l1, mm:=Minimum(mal,Length(a)-i+1); while jfail then break; fi; + if IsInt(p) then break; fi; j:=j+1; od; - if p<>fail then + if IsInt(p) then a:=Concatenation(a{[1..i-1]},tzrules[p][2], a{[i+Length(tzrules[p][1])..Length(a)]}); i:=Maximum(0,i-mal); # earliest which could be affected @@ -758,7 +757,7 @@ local field,fp,fpg,gens,hom,mats,fm,mon,kb,tzrules,dim,rules,eqs,i,j,k,l,o,l1, return a; end; - # normalform word and collect the tails + # normalform word and collect the tails collectail:=function(wrd) local v,tail,i,j,s,p,mm; v:=List(rules,x->zero); @@ -771,24 +770,29 @@ local field,fp,fpg,gens,hom,mats,fm,mon,kb,tzrules,dim,rules,eqs,i,j,k,l,o,l1, j:=0; s:=0; mm:=Minimum(mal,Length(wrd)-i+1); - while jfail do s:=s*max+wrd[i+j]; - #p:=LookupDictionary(dict,s); if s<=lenpre then p:=predict[s]; else p:=LookupDictionary(dict,s); fi; - if p<>fail and rulpos[p]<>fail then break; fi; + if IsInt(p) and rulpos[p]<>fail then break; fi; j:=j+1; od; - if p<>fail and rulpos[p]<>fail then + if IsInt(p) and rulpos[p]<>fail then p:=rulpos[p]; tail:=wrd{[i+Length(rules[p][1])..Length(wrd)]}; wrd:=Concatenation(wrd{[1..i-1]},rules[p][2],tail); -#Print("Apply ",p,"@",i,":",wrd,"\n"); - if p in hastail then v[p]:=v[p]+mapped(tail); fi; + if p in hastail then + if IsIdenticalObj(v[p],zero) then + v[p]:=mapped(tail); + else + v[p]:=v[p]+mapped(tail); + fi; + fi; i:=Maximum(0,i-mal); # earliest which could be affected fi; i:=i+1; @@ -817,6 +821,7 @@ local field,fp,fpg,gens,hom,mats,fm,mon,kb,tzrules,dim,rules,eqs,i,j,k,l,o,l1, # mon!.confl:=tzrules; # fi; # else + # new approach with RWS from chief series mon:=ConfluentMonoidPresentationForGroup(G); fp:=mon.fphom; @@ -830,21 +835,31 @@ local field,fp,fpg,gens,hom,mats,fm,mon,kb,tzrules,dim,rules,eqs,i,j,k,l,o,l1, # that rule set is reduced. max:=Maximum(Union(List(tzrules,x->x[1])))+1; mal:=Maximum(List(tzrules,x->Length(x[1]))); - dict:=NewDictionary(max,Integers,true); + + # leaving out integers makes it a sort dictionary, which behaves better + # for the few entries we typically look up + #dict:=NewDictionary(max,Integers,true); + dict:=NewDictionary(max,true); lenpre:=20000; predict:=ListWithIdenticalEntries(lenpre,fail); + AddDictionary(dict,0,true); for i in [1..mal] do p:=Filtered([1..Length(tzrules)],x->Length(tzrules[x][1])=i); for j in p do s:=0; for k in [1..i] do s:=s*max+tzrules[j][1][k]; + if kImagesRepresentative(hom,x)),mo.field); # new gens - #rules:=ShallowCopy(kb!.tzrules); - #hastail:=Filtered([1..Length(rules)],x->Length(rules[x][1])<>2 or - # Length(rules[x][2])>0 or formalinverse[rules[x][1][1]]<>rules[x][1][2]); - #IsSet(hastail); # quick membership test - l1:=GeneratorsOfGroup(fpg); l1:=Concatenation(l1,List(l1,Inverse)); formalinverse:=[]; @@ -883,21 +893,6 @@ local field,fp,fpg,gens,hom,mats,fm,mon,kb,tzrules,dim,rules,eqs,i,j,k,l,o,l1, then AddSet(hastail,Length(rules)); fi; -# elif Length(r[1])>1 then -# if Length(r[2])=0 then Error("generator is trivial");fi; -# if Length(r[2])<>1 or formalinverse[r[1][1]]<>r[2][1] then -# Add(rules,r); -# AddSet(hastail,Length(rules)); -# else -#Print("Not use: ",r,"\n"); -# # Do not use these rules for overlaps -# if r[2][1]>r[1][1] then -# Error("code assumes that larger number gets reduced to smaller"); -# fi; -# if ForAny(rules,x->r[1][1] in x[2] or (x<>r and r[1][1] in x[1])) then -# Error("rules are not reduced"); -# fi; -# fi; else # Length of r[1] is 1. That is, this generator is not used! m:=First(RelationsOfFpMonoid(mon),x->List(x,LetterRepAssocWord)=r); @@ -961,6 +956,7 @@ local field,fp,fpg,gens,hom,mats,fm,mon,kb,tzrules,dim,rules,eqs,i,j,k,l,o,l1, nvars:=dim*Length(hastail); #Number of variables eqs:=[]; +#rk:=0; zeroq:=ImmutableVector(field,ListWithIdenticalEntries(nvars,Zero(field))); for i in [1..Length(rules)] do l1:=rules[i][1]; @@ -971,7 +967,7 @@ local field,fp,fpg,gens,hom,mats,fm,mon,kb,tzrules,dim,rules,eqs,i,j,k,l,o,l1, for o in [1..m-1] do # possible overlap Length start:=len1-o; if ForAll([1..o],k->l1[start+k]=l2[k]) then - #Print("Overlap ",l1," ",l2," ",o,"\n"); +#Print("Overlap ",l1," ",l2," ",o,"\n"); # apply l1 first new:=Concatenation(rules[i][2],l2{[o+1..Length(l2)]}); @@ -1013,10 +1009,25 @@ local field,fp,fpg,gens,hom,mats,fm,mon,kb,tzrules,dim,rules,eqs,i,j,k,l,o,l1, fi; od; fi; + +# if Length(eqs)>0 then +# c:=RankMat(eqs); +# else +# c:=rk; +# fi; +# if c>rk then rk:=c; +# Print("Overlap ",l1," ",l2," ",o," does reduce further:", +# Length(eqs[1])-rk,"\n"); +# else +# Print(">>Overlap ",l1," ",l2," ",o," does not reduce further\n"); +# fi; + fi; od; od; od; + + eqs:=Filtered(TriangulizedMat(eqs),x->not IsZero(x)); eqs:=NullspaceMat(TransposedMat(eqs)); # basis of cocycles @@ -1116,11 +1127,11 @@ local field,fp,fpg,gens,hom,mats,fm,mon,kb,tzrules,dim,rules,eqs,i,j,k,l,o,l1, else p:=LookupDictionary(dict,s); fi; - if p<>fail and rulpos[p]<>fail then break; fi; + if IsInt(p) and rulpos[p]<>fail then break; fi; j:=j+1; od; - if p<>fail and rulpos[p]<>fail then + if IsInt(p) and rulpos[p]<>fail then p:=rulpos[p]; tail:=wrd{[i+Length(rules[p][1])..Length(wrd)]}; wrd:=Concatenation(wrd{[1..i-1]},rules[p][2],tail); @@ -1190,17 +1201,16 @@ local field,fp,fpg,gens,hom,mats,fm,mon,kb,tzrules,dim,rules,eqs,i,j,k,l,o,l1, mm:=Minimum(mal,Length(wrd)-i+1); while jfail and rulpos[p]<>fail then break; fi; + if IsInt(p) and rulpos[p]<>fail then break; fi; j:=j+1; od; - if p<>fail and rulpos[p]<>fail then + if IsInt(p) and rulpos[p]<>fail then p:=rulpos[p]; tail:=wrd{[i+Length(rules[p][1])..Length(wrd)]}; wrd:=Concatenation(wrd{[1..i-1]},rules[p][2],tail); @@ -1491,7 +1501,7 @@ end); InstallGlobalFunction(FpGroupCocycle,function(arg) local r,z,ogens,n,gens,str,dim,i,j,f,rels,new,quot,g,p,collect,m,e,fp,old,sim, it,hom,trysy,prime,mindeg,fps,ei,mgens,mwrd,nn,newfree,mfpi,mmats,sub, - tab,tab0,evalprod,gensmrep,invsmrep,zerob,step,simi,simiq; + tab,tab0,evalprod,gensmrep,invsmrep,zerob,step,simi,simiq,wasbold; # function to evaluate product (as integer list) in gens (and their # inverses invs) with corresponding action mats @@ -1565,6 +1575,7 @@ local r,z,ogens,n,gens,str,dim,i,j,f,rels,new,quot,g,p,collect,m,e,fp,old,sim, prime:=Size(r.module.field); SetSize(fp,Size(r.group)*prime^r.module.dimension); simi:=fail; + wasbold:=false; if Length(arg)>2 and arg[3]=true then if IsZero(z) and MTX.IsIrreducible(r.module) then @@ -1599,9 +1610,32 @@ local r,z,ogens,n,gens,str,dim,i,j,f,rels,new,quot,g,p,collect,m,e,fp,old,sim, while Size(p)Size(p) then + # take set stabilizer of orbit points. + e:=Set(List(Orbits(p,MovedPoints(p)),x->x[1])); + m:=Stabilizer(p,e,OnSets); + if IndexNC(p,m)>10*NrMovedPoints(p) then + m:=Intersection(MaximalSubgroupClassReps(p)); + fi; + if IndexNC(p,m)>10*NrMovedPoints(p) then + m:=p; # after all.. + wasbold:=false; + else + wasbold:=true; + fi; + fi; + Info(InfoExtReps,3,"Found index ",Index(p,m)); e:=fail; if Index(p,m)>=mindeg and (hom=false or Size(m)=1 or false<>MatricesStabilizerOneDim(r.module.field, @@ -1838,7 +1872,8 @@ local r,z,ogens,n,gens,str,dim,i,j,f,rels,new,quot,g,p,collect,m,e,fp,old,sim, List(GeneratorsOfGroup(fp),x->ImagesRepresentative(quot,x))); fi; - new:=new*SmallerDegreePermutationRepresentation(p:cheap); + # if we used factor perm rep, be bolder + new:=new*SmallerDegreePermutationRepresentation(p:cheap:=wasbold<>true); SetIsomorphismPermGroup(fp,new); fi; From 243e07cea22d36146754b4bee15e0b73fa44e373 Mon Sep 17 00:00:00 2001 From: Alexander Hulpke Date: Thu, 19 Nov 2020 08:20:23 -0700 Subject: [PATCH 3/7] ENHANCE: Isomorphism/Automorphism speedups - Better composition series choice in `SubgroupConditionAbove` -- move known parts on bottom - Improvements in normalizers in `SubgroupConditionAbove`. Use NormalizerViaRadical if there is huge radical bit. - Delay bottom permrep, if bounded orbit algorithms will do the job. - Allow forcing old isomorphism test - Redo generators when searching for trick relators - Require to stabilize sets of normal subgroups (may reduce in factor) Also Typo fix/remove outdated comment in gpfpiso Co-authored-by: Wilf Wilson --- lib/autsr.gi | 435 ++++++++++++++++++++++++++++++++++++++---------- lib/gpfpiso.gi | 3 +- lib/morpheus.gi | 3 +- 3 files changed, 351 insertions(+), 90 deletions(-) diff --git a/lib/autsr.gi b/lib/autsr.gi index 0da35a0cfa..8e320ab280 100644 --- a/lib/autsr.gi +++ b/lib/autsr.gi @@ -85,7 +85,7 @@ end; # case the values of the relators on pre-images in G do not depend on choice # of representatives and can be used to deduce the module automorphism # belonging to a factor group automorphism. -BindGlobal("AGSRFindRels",function(nat) +BindGlobal("AGSRFindRels",function(nat,newgens) local C,M,p,all,gens,sub,q,hom,fp,rels,new,pre,sel,i,free,cnt; M:=KernelOfMultiplicativeGeneralMapping(nat); C:=Centralizer(Source(nat),M); @@ -94,13 +94,24 @@ local C,M,p,all,gens,sub,q,hom,fp,rels,new,pre,sel,i,free,cnt; fi; p:=SmallestPrimeDivisor(Size(M)); all:=[]; - gens:=SmallGeneratingSet(Image(nat)); + if newgens=true then + # so generators new + sub:=TrivialSubgroup(Image(nat)); + while Size(sub)3); cnt:=cnt+1; - until ocr.trickrels<>fail or 2^cnt>10*Size(ocr.moduleauts); + until ocr.trickrels<>fail or 2^cnt>100*Size(ocr.moduleauts); + if ocr.trickrels=fail then Info(InfoMorph,1,"trickrels fails");fi; else ocr.trickrels:=fail; fi; @@ -323,25 +335,72 @@ end); # minimal supergroups and prove that none of them satisfies. BindGlobal("SubgroupConditionAboveAux",function(G,cond,S1,avoid) local S,c,hom,q,a,b,i,t,int,bad,have,ups,up,new,u,good,abort,clim,worked,pp, - cnt,locond,tstcnt; + cnt,locond,tstcnt,setupc,havetest; + + setupc:=function() + hom:=NaturalHomomorphismByNormalSubgroupNC(G,u); + q:=Image(hom,G); + ups:=Image(hom,avoid); + # aim for zuppos that cannot intersect avoid + c:=ConjugacyClasses(q); + c:=Filtered(c,x->IsPrimePowerInt(Order(Representative(x))) and + not Representative(x) in ups); + # elements that do not have prime-order power in the subgroup avoid + c:=Filtered(c,x->not Representative(x)^ + (Order(Representative(x))/SmallestPrimeDivisor(Order(Representative(x)))) + in ups); + # this also implies prime powers after the respective primes + SortBy(c,Size); + + Info(InfoMorph,3,Length(c)," classes with ",Sum(c,Size)," subgroups"); + end; S:=S1; Info(InfoMorph,2,"SubgroupAbove ",IndexNC(G,S)); + # Strategy: First try `SubgroupProperty` with a bailout limit, just in + # case it finds (enough) elements. The bailout limit is set smaller if the + # factor is solvable, as it will be cheaper to find complementing zuppos + # in this case. + + u:=Intersection(S,avoid); + if IsNormal(G,u) and IsNormal(G,avoid) + and HasSolvableFactorGroup(G,u) then + setupc(); + clim:=Minimum(Maximum(QuoInt(Sum(c,Size),4),10),1000); + else + hom:=fail; + # if less than 1/100 percent of elements succeed, assume close + # to the subgroup has been found, and rather aim to prove there + # will not be more. + c:=fail; + clim:=Maximum(QuoInt(IndexNC(G,S),10000),1000); + fi; + + + + # first try, how far `SubgroupProperty` goes b:=0; tstcnt:=0; abort:=false; - # if less than 1/100 percent of elements succeed, assume close - # to the subgroup has been found, and rather aim to prove there - # will not be more. - clim:=Maximum(QuoInt(IndexNC(G,S),10000),1000); - c:=SubgroupProperty(G, + havetest:=[]; + + worked:=SubgroupProperty(G, function(elm) if abort then return true; # are we bailing out since it behaves too badly? fi; + # would it contribute to avoid outside S? + if elm in avoid or + ForAny(Set(Factors(Order(elm))),e->elm^e in avoid and not elm^e in S) + then + # cannot be good + return false; + fi; + tstcnt:=tstcnt+1; + AddSet(havetest,elm); if cond(elm) then S:=ClosureGroup(S,elm); # remember Info(InfoMorph,3,"New element ",IndexNC(G,S)); @@ -358,33 +417,19 @@ local S,c,hom,q,a,b,i,t,int,bad,have,ups,up,new,u,good,abort,clim,worked,pp, if abort=false then # we actually found the subgroup - Info(InfoMorph,2,"SubgroupProperty finds ",IndexNC(G,c)); - return c; + Info(InfoMorph,2,"SubgroupProperty finds index ",IndexNC(G,worked)); + return worked; fi; - Info(InfoMorph,2,"intermediate improvement ",IndexNC(S,S1)); + Info(InfoMorph,2,"SubgroupProperty did ",tstcnt," tests and improved by ", + IndexNC(S,S1)); - u:=Intersection(S,avoid); if not (IsNormal(G,u) and IsNormal(G,avoid)) then Error("may only call if normalizing"); fi; - hom:=NaturalHomomorphismByNormalSubgroupNC(G,u); - q:=Image(hom,G); - ups:=Image(hom,avoid); - # aim for zuppos that cannot intersect avoid - c:=ConjugacyClasses(q); - c:=Filtered(c,x->IsPrimePowerInt(Order(Representative(x))) and - not Representative(x) in ups); - # elements that do not have prime-order power in the subgroup avoid - c:=Filtered(c,x->not Representative(x)^ - (Order(Representative(x))/SmallestPrimeDivisor(Order(Representative(x)))) - in ups); - - # this also implies prime powers after the respective primes - SortBy(c,Size); - - Info(InfoMorph,3,Length(c)," classes, ",Sum(c,Size)); + if c=fail then setupc();fi; + havetest:=Set(List(havetest,x->ImagesRepresentative(hom,x))); locond:=function(elm) tstcnt:=tstcnt+1; @@ -399,6 +444,9 @@ local S,c,hom,q,a,b,i,t,int,bad,have,ups,up,new,u,good,abort,clim,worked,pp, worked:=[]; # indicate whether class worked + + # now run over all Zuppos (Conjugates of class representatives) in factor that do + # not intersect (the image of) avoid. These, that saisfy, will span the correct subgroup. i:=1; while worked<>fail and i<=Length(c) do @@ -428,22 +476,22 @@ local S,c,hom,q,a,b,i,t,int,bad,have,ups,up,new,u,good,abort,clim,worked,pp, if have then have:=false; - a:=PreImagesRepresentative(hom,Representative(c[i])); - b:=PreImage(hom,Normalizer(q,Group(Representative(c[i])))); - Info(InfoMorph,3,"Do class ",i," order =",Order(Representative(c[i])), - ", len=",Size(c[i])," idx=", - IndexNC(G,b)); - t:=RightTransversal(G,b); + a:=Representative(c[i]); + t:=Orbit(q,a); + t:=Filtered(t,x->not x in havetest); + cnt:=0; for b in t do - new:=a^b; + new:=PreImagesRepresentative(hom,b); if (pp=false or new^pp in S) and locond(new) then S:=ClosureGroup(S,new); have:=true; cnt:=cnt+1; fi; od; - Info(InfoMorph,3,"found ",cnt,": ",Size(S)); + Info(InfoMorph,4,"Did class ",i," order =",Order(Representative(c[i])), + ", len=",Size(c[i])," newtest=", Length(t), + " found ",cnt,": ",Size(S)); fi; if worked<>fail then Add(worked,have);fi; i:=i+1; @@ -491,30 +539,148 @@ local S,c,hom,q,a,b,i,t,int,bad,have,ups,up,new,u,good,abort,clim,worked,pp, fi; - Info(InfoMorph,3,"Did ",tstcnt," tests"); + Info(InfoMorph,3,"Did ",tstcnt," tests, grow by ",Index(S,S1)); return S; end); +# Same syntax as `SubgroupProperty`, but assumption that the tests are +# expensive. Thus minimize number of tests by doing more group calculations InstallGlobalFunction(SubgroupConditionAbove,function(G,cond,Sorig) -local cs,nr,u,no,un,S; - S:=Sorig; - cs:=CompositionSeries(G); +local cs,nr,u,no,un,S,rad,res,ise,uno; + + + # first, try to find a few elements that work (and catch the case that the + # subgroup has small index. Ensure we test at least once for each possible + # step. + nr:=2^LogInt(Size(G),1000)+Length(Factors(Size(G))); + u:=[]; + S:=SubgroupProperty(G, + function(elm) + if nr<0 then return true;fi; + nr:=nr-1; + if cond(elm) then + Add(u,elm); + return true; + else + return false; + fi; + end,Sorig); + + if nr>=0 then # succeeded (small index case) + return S; + elif Length(u)>0 then + S:=ClosureGroup(Sorig,u); + else + S:=Sorig; + fi; + + # now build along composition series + + rad:=RadicalGroup(G); + # composition series through perfect residuum seems to work better + # Possible reason: Simple composition factors arise as inner + # automorphisms. Moving the perfect residuum (if smaller) in the series, + # thus increases the chance that much of the subgroup is found early (and + # does not need to be found through search through complements) + res:=PerfectResiduum(G); + + nr:=[Core(G,S),NormalClosure(G,S)]; + + # refine with perfect residuum + no:=Intersection(nr[1],res); + if not no in nr then Add(nr,no);fi; + no:=ClosureGroup(nr[2],res); + if not no in nr then Add(nr,no);fi; + no:=Intersection(nr[2],ClosureGroup(nr[1],res)); + if not no in nr then Add(nr,no);fi; + + cs:=CompositionSeriesThrough(G,nr); + nr:=First([1..Length(cs)],x->IsSubset(S,cs[x])); - u:=cs[nr]; + uno:=false; while nr>1 do nr:=nr-1; - u:=Intersection(cs[nr],S); - no:=Normalizer(cs[nr],Intersection(cs[nr+1],u)); + if IsSubset(cs[nr+1],S) then + + u:=S; + ise:=u; + if uno=false then + # if the group is huge use the radical-based normalizer + if Size(rad)>10^13 and IndexNC(G,ise)>10^5 then + Info(InfoMorph,4,"Radical-based Normalizer:",IndexNC(G,u)); + uno:=NormalizerViaRadical(G,ise); + else + Info(InfoMorph,4,"Ordinary Normalizer:",IndexNC(G,u)); + uno:=Normalizer(G,ise); + fi; + fi; + no:=Intersection(uno,cs[nr]); + else + + u:=Intersection(cs[nr],S); + ise:=Intersection(cs[nr+1],u); + + # if the group is huge use the radical-based normalizer + if Size(Intersection(rad,cs[nr]))>10^13 and IndexNC(cs[nr],ise)>10^5 then + Info(InfoMorph,4,"Radical-based Normalizer:",IndexNC(cs[nr],ise), + " of ",Index(cs[nr],cs[nr+1])); + no:=NormalizerViaRadical(cs[nr],ise); + else + Info(InfoMorph,4,"Ordinary Normalizer:",IndexNC(cs[nr],ise), + " of ",Index(cs[nr],cs[nr+1])); + no:=Normalizer(cs[nr],ise); + fi; + fi; + + un:=Size(no); no:=Group(SmallGeneratingSet(no)); + SetSize(no,un); + un:=SubgroupConditionAboveAux(no,cond,u,Intersection(no,cs[nr+1])); Info(InfoMorph,2, "Step ",nr,": ",IndexNC(cs[nr],cs[nr+1])," to ",IndexNC(un,u)); - if not IsSubset(S,un) then S:=ClosureGroup(S,un);fi; + if not IsSubset(S,un) then + S:=ClosureGroup(S,un); + uno:=false; + fi; od; return S; end); +# find classes of normal subgroups +BindGlobal("AGSRNormalSubgroupClasses",function(G) +local fp,n,pat,pools,i,sel; + # fingerprint + fp:=function(x) + local l; + if ID_AVAILABLE(Size(x)) <> fail + and ValueOption(NO_PRECOMPUTED_DATA_OPTION)<>true then + return IdGroup(x); + fi; + l:=[Size(x)]; + Add(l,Collected(List(ConjugacyClasses(x), + y->[Order(Representative(y)),Size(y)]))); + Add(l,AbelianInvariants(x)); + return l; + end; + n:=ValueOption("directs"); + if n<>fail then + # avoid large number of normals in direct product + n:=Concatenation(List(n, + x->Filtered(NormalSubgroups(x),y->Size(y)>1 and Size(y)pat[x]=i); + Add(pools,n{sel}); + od; + return pools; +end); + # main automorphism method -- currently still using factor groups, but # nevertheless faster.. @@ -525,7 +691,7 @@ 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; + scharorb,asAutom,jorb,jorpo,substb,isBadPermrep,ma,nosucl,nosuf; # criterion for when to force degree reduction isBadPermrep:=function(g) @@ -535,6 +701,7 @@ local ff,r,d,ser,u,v,i,j,k,p,bd,e,gens,lhom,M,N,hom,Q,Mim,q,ocr,split,MPcgs, asAutom:=function(sub,hom) return Image(hom,sub);end; actbase:=ValueOption("autactbase"); + nosucl:=fail; makeaqiso:=function() local a,b; @@ -1010,17 +1177,38 @@ local ff,r,d,ser,u,v,i,j,k,p,bd,e,gens,lhom,M,N,hom,Q,Mim,q,ocr,split,MPcgs, fi; sub:=AQP; - #if Size(KernelOfMultiplicativeGeneralMapping(hom))=1 then - # Error("trigger"); - #fi; if precond<>fail and not ForAll(GeneratorsOfGroup(sub),precond) then + # compatible pairs condition sub:=SubgroupProperty(sub,precond,Aperm); fi; - # desperately try to grab some further generators - #stablim(sub,cond,10000)=false then + if IndexNC(sub,Aperm)>10^6 then + # try to find characteristic subgroups + Info(InfoMorph,2,"Use normal subgroup classes"); + if nosucl=fail then nosucl:=AGSRNormalSubgroupClasses(G);fi; + nosuf:=List(nosucl,x->Set(List(x,y->Image(lhom,y)))); + nosuf:=Filtered(nosuf,x->Size(x[1])>1 and Size(x[1])PreImagesRepresentative(AQiso,x)), + rec(pnt:=j, + act:= + function(set,phi) + #local phi; + #phi:=PreImagesRepresentative(AQiso,perm); + return Set(List(set,x->Image(phi,x))); + end, + onlystab:=true)); + Info(InfoMorph,3,"Improved index ",IndexNC(sub,ac.stabilizer)); + if Size(ac.stabilizer)1000000 then Error("Million"); fi; j:=Size(sub); Info(InfoMorph,2,"start search ",IndexNC(sub,Aperm)); sub:=SubgroupConditionAbove(sub,cond,Aperm); @@ -1070,9 +1258,14 @@ local ff,r,d,ser,u,v,i,j,k,p,bd,e,gens,lhom,M,N,hom,Q,Mim,q,ocr,split,MPcgs, AQI:=SubgroupNC(A,innB); SetInnerAutomorphismsAutomorphismGroup(A,AQI); AQ:=A; - makeaqiso(); - if not IsIdenticalObj(A,AQ) then - A:=AQ; + if Size(KernelOfMultiplicativeGeneralMapping(hom))>1 + or ValueOption("delaypermrep")<>true then + makeaqiso(); + if not IsIdenticalObj(A,AQ) then + A:=AQ; + fi; + else + A!.makeaqiso:=makeaqiso; fi; # do we use induced radical automorphisms to help next step? @@ -1445,6 +1638,33 @@ local a,props,cg,ch,clg,clh,ng,nh,coug,couh,pg,ph,i,j,stop,coinc; ); end); +BindGlobal("AGBoundedOrbrep",function(G,from,to,act,bound) +local orb,rep,S,i,g,img,p; + orb:=[from]; + rep:=[One(G)]; + S:=[]; + i:=1; + while i<=Length(orb) do + for g in GeneratorsOfGroup(G) do + img:=act(orb[i],g); + p:=Position(orb,img); + if p=fail then + if Length(orb)>=bound then return fail;fi; # length bailout + Add(orb,img); + Add(rep,rep[i]*g); + else + img:=rep[i]*g/rep[p]; + if not (img in S or img^-1 in S) then + Add(S,img); + fi; + fi; + od; + i:=i+1; + od; + p:=Position(orb,to); + if p=fail then return false;fi; # not in orbit + return rec(rep:=rep[p],orblen:=Length(orb),stabgens:=S); +end); # pathetic isomorphism test, based on the automorphism group of GxH. This is @@ -1452,7 +1672,8 @@ end); # 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; + iso,api,good,gens,pre,aab,as; + possibly:=function(a,b) if Size(a)<>Size(b) then return false; @@ -1559,14 +1780,16 @@ local d,a,map,possibly,cG,cH,nG,nH,i,j,sel,u,v,asAutomorphism,K,L,conj,e1,e2, fi; od; - K:=[Image(e1,G),Image(e2,H)]; + aab:=[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:= + a:=AutomorphismGroup(d:autactbase:=aab,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); + orbits:=List([1..Length(nG)],x->[Image(e1,nG[x]),Image(e2,nH[x])])), + directs:=aab, + delaypermrep:=true ); + + iso:=fail; #if NrMovedPoints(api)>5000 then # K:=SmallerDegreePermutationRepresentation(api); # Info(InfoMorph,2,"Permdegree reduced ", @@ -1579,33 +1802,71 @@ local d,a,map,possibly,cG,cH,nG,nH,i,j,sel,u,v,asAutomorphism,K,L,conj,e1,e2, 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; + map:=AGBoundedOrbrep(a,K,L,asAutomorphism,20); + if map=false then + Info(InfoMorph,1,"Shortorb test noniso"); + return fail; + elif map<>fail then + conj:=map.rep; + Info(InfoMorph,1,"Shortorb test iso found"); + else + + as:=a; + Add(cG,TrivialSubgroup(d)); + + for i in cG do + u:=ClosureGroup(i,K); + v:=ClosureGroup(i,L); + if u<>v then + + # try cheap orbit stabilizer first + if iso<>fail then + map:=fail; + else + map:=AGBoundedOrbrep(as,u,v,asAutomorphism,100); + fi; + if map=false then + Info(InfoMorph,1,"Shortorb factor noniso"); + return fail; + elif map<>fail then + Info(InfoMorph,1,"Shortorb factor reduce ",map.orblen); + as:=SubgroupNC(Parent(as),map.stabgens); + map:=map.rep; + conj:=conj*map; + K:=Image(map,K); + as:=as^map; + else + if iso=fail then + Info(InfoMorph,1,"Shortorb failed, get delayed permrep"); + if IsBound(a!.makeaqiso) then a!.makeaqiso();fi; + iso:=IsomorphismPermGroup(a:autactbase:=aab); + api:=Image(iso,as); + fi; + + 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; fi; - conj:=conj*map; - K:=Image(map,K); + od; - 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; + fi; return GroupHomomorphismByImagesNC(G,H,GeneratorsOfGroup(G), List(GeneratorsOfGroup(G),x->PreImagesRepresentative(e2, Image(conj,Image(e1,x))))); end); - diff --git a/lib/gpfpiso.gi b/lib/gpfpiso.gi index 6bb1e77046..465b093278 100644 --- a/lib/gpfpiso.gi +++ b/lib/gpfpiso.gi @@ -1124,7 +1124,6 @@ local iso,fp,n,dec,homs,mos,i,j,ffp,imo,m,k,gens,fm,mgens,rules, reduce:=function(w) local red,i,p,pool,wn; -#ow:=w; w:=LetterRepAssocWord(w); repeat i:=1; @@ -1288,7 +1287,7 @@ end); # special method for pc groups, basically just writing down the pc # presentation -InstallMethod(ConfluentMonoidPresentationForGroup,"generic", +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; diff --git a/lib/morpheus.gi b/lib/morpheus.gi index d05884fe0a..d487bb4726 100644 --- a/lib/morpheus.gi +++ b/lib/morpheus.gi @@ -2675,7 +2675,8 @@ local m; # the group is a good part # sizeable radical or Size(RadicalGroup(G))^2>Size(G) - or ValueOption("forcetest")=true) then + or ValueOption("forcetest")=true) and + ValueOption("forcetest")<>"old" then # In place until a proper implementation of Cannon/Holt isomorphism is # done return PatheticIsomorphism(G,H); From 1474417a63075411e834063f24115f79e0fb8cb5 Mon Sep 17 00:00:00 2001 From: Alexander Hulpke Date: Fri, 5 Feb 2021 12:55:11 -0700 Subject: [PATCH 4/7] ENHANCE: ``onlyone'' option for `ContainedConjugates` --- lib/grplatt.gd | 16 ++++++++++++---- lib/grplatt.gi | 34 +++++++++++++++++++++++++--------- 2 files changed, 37 insertions(+), 13 deletions(-) diff --git a/lib/grplatt.gd b/lib/grplatt.gd index 2a2c80843c..9912296ffe 100644 --- a/lib/grplatt.gd +++ b/lib/grplatt.gd @@ -449,21 +449,29 @@ DeclareGlobalFunction("LowLayerSubgroups"); ############################################################################# ## -#O ContainedConjugates(,,) +#O ContainedConjugates(,,[,]) ## ## <#GAPDoc Label="ContainedConjugates"> ## -## +## ## ## ## For A,B \leq G this operation returns representatives of the A ## conjugacy classes of subgroups that are conjugate to B under G. ## The function returns a list of pairs of subgroup and conjugating element. +## If the optional fourth argument onlyone is given as true, +## then only one pair (or fail if none exists) is returned. ## g:=SymmetricGroup(8);; -## gap> a:=TransitiveGroup(8,47);;b:=TransitiveGroup(8,7);; +## gap> a:=TransitiveGroup(8,47);;b:=TransitiveGroup(8,9);; ## gap> ContainedConjugates(g,a,b); -## [ [ Group([ (1,4,2,5,3,6,8,7), (1,3)(2,8) ]), (2,4,5,3)(7,8) ] ] +## [ [ Group([ (1,8)(2,3)(4,5)(6,7), (1,3)(2,8)(4,6)(5,7), (1,5)(2,6)(3,7)(4,8), +## (4,5)(6,7) ]), () ], +## [ Group([ (1,8)(2,3)(4,5)(6,7), (1,5)(2,6)(3,7)(4,8), (1,3)(2,8)(4,6)(5,7), +## (2,3)(6,7) ]), (2,4)(3,5) ] ] +## gap> ContainedConjugates(g,a,b,true); +## [ Group([ (1,8)(2,3)(4,5)(6,7), (1,3)(2,8)(4,6)(5,7), (1,5)(2,6)(3,7)(4,8), +## (4,5)(6,7) ]), () ] ## ]]> ## ## diff --git a/lib/grplatt.gi b/lib/grplatt.gi index eaaaee58fe..da054f1342 100644 --- a/lib/grplatt.gi +++ b/lib/grplatt.gi @@ -3187,13 +3187,13 @@ local act,offset,G,lim,cond,dosub,all,m,i,j,new,old; return all; end); -############################################################################# -## -#F ContainedConjugates( , , ) -## -InstallMethod(ContainedConjugates,"finite groups",IsFamFamFam,[IsGroup,IsGroup,IsGroup],0, -function(G,A,B) -local l,N,dc,gens,i; +DoContainedConjugates:=function(arg) +local G,A,B,onlyone,l,N,dc,gens,i; + G:=arg[1]; + A:=arg[2]; + B:=arg[3]; + if Length(arg)>3 then onlyone:=arg[4]; else onlyone:=false;fi; + if not IsFinite(G) and IsFinite(A) and IsFinite(B) then TryNextMethod(); fi; @@ -3201,7 +3201,8 @@ local l,N,dc,gens,i; Error("A and B must be subgroups of G"); fi; if Size(A) mod Size(B)<>0 then - return []; # cannot be contained by order + # cannot be contained by order + if onlyone then return fail;else return [];fi; fi; l:=[]; @@ -3211,15 +3212,30 @@ local l,N,dc,gens,i; gens:=SmallGeneratingSet(B); for i in dc do if ForAll(gens,x->x^i[1] in A) then + if onlyone then return [B^i[1],i[1]];fi; Add(l,[B^i[1],i[1]]); fi; od; + if onlyone then return fail;fi; return l; + elif onlyone then + l:=DoConjugateInto(G,A,B,true); + if IsIdenticalObj(FamilyObj(l),FamilyObj(One(G))) then return [B^l,l]; + else return fail;fi; else l:=DoConjugateInto(G,A,B,false); return List(l,x->[B^x,x]); fi; -end); +end; + +############################################################################# +## +#F ContainedConjugates( , , ) +## +InstallMethod(ContainedConjugates,"finite groups",IsFamFamFam, + [IsGroup,IsGroup,IsGroup],0,DoContainedConjugates); +InstallOtherMethod(ContainedConjugates,"onlyone",IsFamFamFamX, + [IsGroup,IsGroup,IsGroup,IsBool],0,DoContainedConjugates); ############################################################################# ## From 1e7055981804a24d851141efefa9d0ba72598dc4 Mon Sep 17 00:00:00 2001 From: Alexander Hulpke Date: Sun, 7 Feb 2021 11:30:09 -0700 Subject: [PATCH 5/7] FIX: IntermediateGroup will not exit quietly if index is large --- lib/csetgrp.gi | 19 ++++++++++++++++--- .../2021-02-07-IntermediateGroup.tst | 6 ++++++ 2 files changed, 22 insertions(+), 3 deletions(-) create mode 100644 tst/testbugfix/2021-02-07-IntermediateGroup.tst diff --git a/lib/csetgrp.gi b/lib/csetgrp.gi index 945c2c0f10..ed659446eb 100644 --- a/lib/csetgrp.gi +++ b/lib/csetgrp.gi @@ -330,8 +330,6 @@ local o,b,img,G1,c,m,mt,hardlimit,gens,t,k,intersize; return fail; fi; - # old code -- obsolete - c:=ValueOption("refineChainActionLimit"); if IsInt(c) then hardlimit:=c; @@ -339,7 +337,22 @@ local o,b,img,G1,c,m,mt,hardlimit,gens,t,k,intersize; hardlimit:=1000000; fi; - if Index(G,U)>hardlimit then return fail;fi; + if Index(G,U)>hardlimit/10 + and ValueOption("callinintermediategroup")<>true then + # try the `AscendingChain` mechanism + c:=AscendingChain(G,U:cheap,refineIndex:=QuoInt(IndexNC(G,U),2), + callinintermediategroup); + if Length(c)>2 then + return First(c,x->Size(x)>Size(U)); + fi; + fi; + + if Index(G,U)>hardlimit then + Info(InfoWarning,1, + "will have to use permutation action of degree bigger than ", hardlimit); + fi; + + # old code -- obsolete if IsPermGroup(G) and Length(GeneratorsOfGroup(G))>3 then G1:=Group(SmallGeneratingSet(G)); diff --git a/tst/testbugfix/2021-02-07-IntermediateGroup.tst b/tst/testbugfix/2021-02-07-IntermediateGroup.tst new file mode 100644 index 0000000000..d57e7f49eb --- /dev/null +++ b/tst/testbugfix/2021-02-07-IntermediateGroup.tst @@ -0,0 +1,6 @@ +# IntermediateGroup in large index, reported in Forum (Breuer/Anvita) on 2/7/21 +gap> L:=PSL(2,7^3);; +gap> S:=SylowSubgroup(L,2);; +gap> u:=IntermediateGroup(L,S);; +gap> IsGroup(u) and Size(u)>Size(S); +true From 2dbbe7f5b62ce2f387458c8b5a6ada41cf07c6b8 Mon Sep 17 00:00:00 2001 From: Alexander Hulpke Date: Mon, 8 Feb 2021 14:05:44 -0700 Subject: [PATCH 6/7] TEST: Added test for CompositionSeriesThrough --- tst/teststandard/grpprmcs.tst | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tst/teststandard/grpprmcs.tst b/tst/teststandard/grpprmcs.tst index d41d7d0cf3..056bb2ad6b 100644 --- a/tst/teststandard/grpprmcs.tst +++ b/tst/teststandard/grpprmcs.tst @@ -312,6 +312,10 @@ Group Group gap> List( ChiefSeriesOfGroup( g ), Size ); [ 1215506, 607753, 31987, 1103, 1 ] +gap> u:=NormalClosure(g,SylowSubgroup(g,2));; +gap> cs:=ChiefSeriesThrough(g,[u]);; +gap> List(cs,Size); +[ 1215506, 63974, 2206, 1103, 1 ] # $Co_2$ on 2300 points gap> g:= From 3506a28a55a8f469ce03b67e6c81c3e3685f7e81 Mon Sep 17 00:00:00 2001 From: Alexander Hulpke Date: Tue, 9 Feb 2021 08:38:41 -0700 Subject: [PATCH 7/7] Update tst/teststandard/grpprmcs.tst Co-authored-by: Wilf Wilson --- tst/teststandard/grpprmcs.tst | 3 +++ 1 file changed, 3 insertions(+) diff --git a/tst/teststandard/grpprmcs.tst b/tst/teststandard/grpprmcs.tst index 056bb2ad6b..b02065e6b5 100644 --- a/tst/teststandard/grpprmcs.tst +++ b/tst/teststandard/grpprmcs.tst @@ -316,6 +316,9 @@ gap> u:=NormalClosure(g,SylowSubgroup(g,2));; gap> cs:=ChiefSeriesThrough(g,[u]);; gap> List(cs,Size); [ 1215506, 63974, 2206, 1103, 1 ] +gap> cs:=CompositionSeriesThrough(g,[u]);; +gap> List(cs,Size); +[ 1215506, 63974, 2206, 1103, 1 ] # $Co_2$ on 2300 points gap> g:=