Merge pull request #2383 from hulpke/additions

Speed improvements for automorphism groups: Improvements to element order, to SmallGeneratingSet for large degree permutation groups (that come up in the automorphisms groups code) and for isomorphism test in the case of solvable automorphism groups.

This had to wait for the immediate methods patch to be sorted out, because it makes the issue disappear.

doc/tut/group.xml

@@ -833,9 +833,9 @@ usual way we now look for the subgroups above <C>u105</C>.
 gap> blocks := Blocks( a8, orb );; Length( blocks );
 15
 gap> blocks[1];
-[ (1,2)(3,4)(5,6)(7,8), (1,3)(2,4)(5,8)(6,7), (1,4)(2,3)(5,7)(6,8), 
-  (1,5)(2,6)(3,8)(4,7), (1,6)(2,5)(3,7)(4,8), (1,7)(2,8)(3,6)(4,5), 
-  (1,8)(2,7)(3,5)(4,6) ]
+[ (1,2)(3,4)(5,6)(7,8), (1,3)(2,4)(5,7)(6,8), (1,4)(2,3)(5,8)(6,7),
+  (1,5)(2,6)(3,7)(4,8), (1,6)(2,5)(3,8)(4,7), (1,7)(2,8)(3,5)(4,6),
+  (1,8)(2,7)(3,6)(4,5) ]
 ]]></Example>
 <P/>
 To find the subgroup of index 15 we  again use closure. Now  we must be a
@@ -1175,8 +1175,8 @@ gap> aut := AutomorphismGroup( p );; NiceMonomorphism(aut);;
 gap> niceaut := NiceObject( aut );
 Group([ (1,4,2,3), (1,5,4)(2,6,3), (1,2)(3,4), (3,4)(5,6) ])
 gap> IsomorphismGroups( niceaut, SymmetricGroup( 4 ) );
-[ (1,4,2,3), (1,5,4)(2,6,3), (1,2)(3,4), (3,4)(5,6) ] -> 
-[ (1,4,3,2), (1,4,2), (1,3)(2,4), (1,4)(2,3) ]
+[ (1,4,2,3), (1,5,4)(2,6,3), (1,2)(3,4), (3,4)(5,6) ] ->
+[ (1,4,2,3), (1,2,3), (1,2)(3,4), (1,3)(2,4) ]
 ]]></Example>
 <P/>
 The range of  a nice monomorphism is  in most cases a permutation  group,

lib/autsr.gi

@@ -941,7 +941,11 @@ local d,a,map,possibly,cG,cH,nG,nH,i,j,sel,u,v,asAutomorphism,K,L,conj,e1,e2,
     u:=ClosureGroup(i,K);
     v:=ClosureGroup(i,L);
     if u<>v then
-      gens:=SmallGeneratingSet(api);
+      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

lib/ctbl.gd

@@ -4382,11 +4382,11 @@ DeclareGlobalFunction( "NormalSubgroupClasses" );
 ##    Character( CharacterTable( S4 ), [ 3, 1, -1, 0, -1 ] ), 
 ##    Character( CharacterTable( S4 ), [ 1, 1, 1, 1, 1 ] ) ]
 ##  gap> kernel:= KernelOfCharacter( irr[3] );
-##  Group([ (1,2)(3,4), (1,3)(2,4) ])
+##  Group([ (1,2)(3,4), (1,4)(2,3) ])
 ##  gap> HasNormalSubgroupClassesInfo( tbl );
 ##  true
 ##  gap> NormalSubgroupClassesInfo( tbl );
-##  rec( nsg := [ Group([ (1,2)(3,4), (1,3)(2,4) ]) ], 
+##  rec( nsg := [ Group([ (1,2)(3,4), (1,4)(2,3) ]) ],
 ##    nsgclasses := [ [ 1, 3 ] ], nsgfactors := [  ] )
 ##  gap> ClassPositionsOfNormalSubgroup( tbl, kernel );
 ##  [ 1, 3 ]

lib/grpperm.gi

@@ -1892,10 +1892,20 @@ end);
 InstallMethod(SmallGeneratingSet,"random and generators subset, randsims",true,
   [IsPermGroup],0,
 function (G)
-local  i, j, U, gens,o,v,a,sel,min;
+local  i, j, U, gens,o,v,a,sel,min,orb,orp,ok;
 
-  # remove obvious redundancies
   gens := ShallowCopy(Set(GeneratorsOfGroup(G)));
+
+  # try pc methods first. The solvability test should not exceed cost, nor
+  # the number of points.
+  if #Length(MovedPoints(G))<50000 and 
+   #((HasIsSolvableGroup(G) and IsSolvableGroup(G)) or IsAbelian(G))
+      IsSolvableGroup(G) 
+      and Length(gens)>3 then
+    return MinimalGeneratingSet(G);
+  fi;
+
+  # remove obvious redundancies
   o:=List(gens,Order);
   SortParallel(o,gens,function(a,b) return a>b;end);
   sel:=Filtered([1..Length(gens)],x->o[x]>1);
@@ -1920,26 +1930,32 @@ local  i, j, U, gens,o,v,a,sel,min;
   od;
   gens:=gens{sel};
 
-  # try pc methods first
-  if Length(MovedPoints(G))<1000 and HasIsSolvableGroup(G) 
-     and IsSolvableGroup(G) and Length(gens)>3 then
-    return MinimalGeneratingSet(G);
-  fi;
-
+  # store orbit data
+  orb:=Set(List(Orbits(G,MovedPoints(G)),Set));
+  orp:=Filtered([1..Length(orb)],x->IsPrimitive(Action(G,orb[x])));
 
   min:=2;
   if Length(gens)>2 then
   # minimal: AbelianInvariants
     min:=Maximum(List(Collected(Factors(Size(G)/Size(DerivedSubgroup(G)))),x->x[2]));
+    if min=Length(GeneratorsOfGroup(G)) then return GeneratorsOfGroup(G);fi;
     i:=Maximum(2,min);
     while i<=min+1 and i<Length(gens) do
       # try to find a small generating system by random search
       j:=1;
       while j<=5 and i<Length(gens) do
         U:=Subgroup(G,List([1..i],j->Random(G)));
+        ok:=true;
+        # first test orbits
+        if ok then
+          ok:=Length(orb)=Length(Orbits(U,MovedPoints(U))) and
+              ForAll(orp,x->IsPrimitive(U,orb[x]));
+        fi;
+
+
 	StabChainOptions(U).random:=100; # randomized size
 #Print("A:",i,",",j," ",Size(G)/Size(U),"\n");
-        if Size(U)=Size(G) then
+        if ok and Size(U)=Size(G) then
           gens:=Set(GeneratorsOfGroup(U));
         fi;
         j:=j+1;
@@ -1955,6 +1971,14 @@ local  i, j, U, gens,o,v,a,sel,min;
   while i <= Length(gens) and Length(gens)>min do
     # random did not improve much, try subsets
     U:=Subgroup(G,gens{Difference([1..Length(gens)],[i])});
+
+    ok:=true;
+    # first test orbits
+    if ok then
+      ok:=Length(orb)=Length(Orbits(U,MovedPoints(U))) and
+          ForAll(orp,x->IsPrimitive(U,orb[x]));
+    fi;
+
     StabChainOptions(U).random:=100; # randomized size
 #Print("B:",i," ",Size(G)/Size(U),"\n");
     if Size(U)<Size(G) then

lib/morpheus.gi

@@ -16,36 +16,111 @@
 ##
 MORPHEUSELMS := 50000;
 
+# this method calculates a chief series invariant under `hom` and calculates
+# orders of group elements in factors of this series under action of `hom`.
+# Every time an orbit length is found, `hom` is replaced by the appropriate
+# power. Initially small chief factors are preferred. In the end all
+# generators are used while stepping through the series descendingly, thus
+# ensuring the proper order is found.
 InstallMethod(Order,"for automorphisms",true,[IsGroupHomomorphism],0,
 function(hom)
-local map,phi,o,lo,i,start,img;
+local map,phi,o,lo,i,j,start,img,d,nat,ser,jord,first;
+  d:=Source(hom);
+  if Size(d)<=10000 then
+    ser:=[d,TrivialSubgroup(d)]; # no need to be clever if small
+  else
+    if HasAutomorphismGroup(d) then
+      if IsBound(d!.characteristicSeries) then
+        ser:=d!.characteristicSeries;
+      else
+        ser:=ChiefSeries(d); # could try to be more clever, introduce attribute
+        # `CharacteristicSeries`.
+        ser:=Filtered(ser,x->ForAll(GeneratorsOfGroup(AutomorphismGroup(d)),
+          a->ForAll(GeneratorsOfGroup(x),y->ImageElm(a,y) in x)));
+        d!.characteristicSeries:=ser;
+      fi;
+    else
+      ser:=ChiefSeries(d); # could try to be more clever, introduce attribute
+      # `CharacteristicSeries`.
+      ser:=Filtered(ser,
+            x->ForAll(GeneratorsOfGroup(x),y->ImageElm(hom,y) in x));
+    fi;
+  fi;
+
+  # try to do factors in ascending order in the hope to get short orbits
+  # first
+  jord:=[2..Length(ser)]; # order in which we go through factors
+  if Length(ser)>2 then
+    i:=List(jord,x->Size(ser[x-1])/Size(ser[x]));
+    SortParallel(i,jord);
+  fi;
+
   o:=1;
   phi:=hom;
   map:=MappingGeneratorsImages(phi);
-  i:=1;
-  while i<=Length(map[1]) do
-    lo:=1;
-    start:=map[1][i];
-    img:=map[2][i];
-    while img<>start do
-      img:=ImagesRepresentative(phi,img);
-      lo:=lo+1;
-      # do the bijectivity test only if high local order, then it does not
-      # matter
-      if lo=1000 and not IsBijective(hom) then
-	Error("<hom> must be bijective");
-      fi;
+
+  first:=true;
+  while map[1]<>map[2] do
+    for j in jord do
+      i:=1;
+      while i<=Length(map[1]) do
+        # the first time, do only the generators from prior layer
+        if (not first) 
+           or (map[1][i] in ser[j-1] and not map[1][i] in ser[j]) then
+
+          lo:=1;
+          if j<Length(ser) then
+            nat:=NaturalHomomorphismByNormalSubgroup(d,ser[j]);
+            start:=ImagesRepresentative(nat,map[1][i]);
+            img:=map[2][i];
+            while ImagesRepresentative(nat,img)<>start do
+              img:=ImagesRepresentative(phi,img);
+              lo:=lo+1;
+
+              # do the bijectivity test only if high local order, then it
+              # does not matter. IsBijective is cached, so second test is
+              # cheap.
+              if lo=1000 and not IsBijective(hom) then
+                Error("<hom> must be bijective");
+              fi;
+
+            od;
+
+          else
+            start:=map[1][i];
+            img:=map[2][i];
+            while img<>start do
+              img:=ImagesRepresentative(phi,img);
+              lo:=lo+1;
+
+              # do the bijectivity test only if high local order, then it
+              # does not matter. IsBijective is cached, so second test is
+              # cheap.
+              if lo=1000 and not IsBijective(hom) then
+                Error("<hom> must be bijective");
+              fi;
+
+            od;
+          fi;
+
+          if lo>1 then
+            o:=o*lo;
+            #if i<Length(map[1]) then
+              phi:=phi^lo;
+              map:=MappingGeneratorsImages(phi);
+              i:=0; # restart search, as generator set may have changed.
+            #fi;
+          fi;
+        fi;
+        i:=i+1;
+      od;
     od;
-    if lo>1 then
-      o:=o*lo;
-      if i<Length(map[1]) then
-	phi:=phi^lo;
-	map:=MappingGeneratorsImages(phi);
-        i:=0; # restart search, as generator set may have changed.
-      fi;
-    fi;
-    i:=i+1;
+
+    # if iterating make `jord` standard to we don't skip generators
+    jord:=[2..Length(ser)];
+    first:=false;
   od;
+
   return o;
 end);
 

lib/teaching.g

@@ -194,9 +194,9 @@ DeclareGlobalFunction("CosetDecomposition");
 ##  <A>H</A>-conjugacy.
 ##  <Example><![CDATA[
 ##  gap> AllHomomorphismClasses(SymmetricGroup(4),SymmetricGroup(3)); 
-##  [ [ (2,4,3), (1,2,3,4) ] -> [ (), () ], 
-##    [ (2,4,3), (1,2,3,4) ] -> [ (), (1,2) ], 
-##    [ (2,4,3), (1,2,3,4) ] -> [ (1,2,3), (1,2) ] ]
+##  [ [ (1,2,3), (2,4) ] -> [ (), () ],
+##    [ (1,2,3), (2,4) ] -> [ (), (1,2) ],
+##    [ (1,2,3), (2,4) ] -> [ (1,2,3), (1,2) ] ]
 ##  ]]></Example>
 ##  </Description>
 ##  </ManSection>