On Butler's book

Fundamental algorithms for permutation groups
G. Butler, Springer-Verlag, Heidelberg 1991

This notebook checks (or corrects) most of the examples given in that book.

	J. M. Martin-Garcia
	(c) 2003-2008, under GPL
	Instituto de Estructura de la Materia, CSIC, Madrid (SPAIN)
	jmm@iem.cfmac.csic.es
	
This notebook is part of the documentation of the package xAct`xPerm` for efficient manipulation of permutations under Mathematica. The package and its documentation are released under the GNU General Public License.

Load xPerm

<< xAct`xPerm`

Simple functions, only used in this notebook:

PrintSchreier[Schreier[orbits__List, w_, nu_]] := 
      With[{points = Union[orbits]}, 
        TableForm[{points, w[[points]] /. (0 -> "Init"), 
            nu[[points]]}]]

NameRules[symb_, n_, 
        not_] := Rule[
            TranslatePerm[ToExpression@#, 
              not], #] & /@ (ToString@symb <> # & /@ ToString /@ 
              Range[n])

NameRules[h, 0, Perm]

$PrePrint = ReplaceAll[#, $xPermRules] &;

Example 0

Examples in chapter 7, pages 57-61.

a = Cycles[{1, 4, 5, 11, 6, 10, 3, 2}, {7, 8}];
b = Cycles[{1, 4, 5, 11, 6, 10, 3, 2}, {8, 9}];
c = Cycles[{1, 4, 2, 3}, {5, 11, 10, 6}];

$xPermRules = {a -> "a", b -> "b", 
          c -> "c"};

Single orbits:

Orbit[7, GenSet[a, b, c]]

Orbit[1, GenSet[a, b, c]]

SchreierOrbit[7, GenSet[a, b, c], 11]

PrintSchreier[%]

SchreierOrbit[1, GenSet[a, b, c], 11]

PrintSchreier[%]

All orbits:

Orbits[GenSet[a, b, c], 11]

SchreierOrbits[GenSet[a, b, c], 11]

PrintSchreier[%]

Example 1. Symmetries of the square

Example in page 80 of Butler.

a = Cycles[{1, 2, 3, 4}];
b = Cycles[{2, 4}];

SGS = StrongGenSet[{1, 2}, GenSet[a, b]];

We can test membership in G=G^(1):

PermMemberQ[ID, SGS]

PermMemberQ[Permute[a, b], SGS]

PermMemberQ[Cycles[{2, 1, 3, 4}], SGS]

And membership in G^(2):

Stabilizer[{1}, GenSet[a, b]] == GenSet[b]

PermMemberQ[a, StrongGenSet[{4}, GenSet[b]]]

PermMemberQ[b, StrongGenSet[{4}, GenSet[b]]]

PermMemberQ[ID, StrongGenSet[{4}, GenSet[b]]]

And membership in G^(3):

PermMemberQ[ID, StrongGenSet[{}, GenSet[]]]

Chain of stabilizers:

StabilizerChain[SGS] // ColumnForm

$xPermRules = {a -> "a", b -> "b"};

Schreier vectors:

PrintSchreier[
      SchreierOrbit[1, StabilizerChain[SGS][[1, 2]], 4]]

PrintSchreier[
      SchreierOrbit[2, StabilizerChain[SGS][[2, 2]], 4]]

Construction of the pair (base,SGS) from scratch:

SchreierSims[{1}, GenSet[a, b], 4, 
      xPermVerbose -> True]

OrderOfGroup[SGS]

Example 2. Projective plane of order 2

Example in page 81 of Butler.

Generators:

a = Cycles[{1, 2, 4, 5, 7, 3, 6}];
b = Cycles[{2, 4}, {3, 5}];

Strong generating set:

s1 = a;
s2 = b;
s3 = Cycles[{4, 5}, {6, 7}];
s4 = Cycles[{4, 6}, {5, 7}];

B = {1, 2, 4};
S = GenSet[s1, s2, s3, s4];
SGS = StrongGenSet[B, S];

Order of group:

OrderOfGroup[SGS]

g1 = Perm[{1, 7, 6, 5, 4, 2, 3}];
g2 = Perm[{1, 2, 3, 7, 6, 5, 4}];

$xPermRules = 
        Join[NameRules[s, 4, Cycles], NameRules[g, 2, Cycles]];

Chain of stabilizers:

(chain = StabilizerChain[SGS]) // ColumnForm

Let us analyze the structure of those subgroups, starting from below:

OrderOfGroup /@ chain

The subgroup G^(4) is just {ID} and it is generated by the base {} and the GS {}:

OrderOfGroup[StrongGenSet[{}, GenSet[]]]

Then we have G^(3), which is generated by the base {4} and the GS {s3, s4}:

OrderOfGroup[StrongGenSet[{4}, GenSet[s3, s4]]]

Elements of the group:

Dimino[GenSet[s3, s4]]

There is just one orbit:

SchreierOrbit[4, GenSet[s3, s4], 7]

Then we have G^(2), which is generated by the base {2,4} and the GS {s2, s3, s4}:

OrderOfGroup[StrongGenSet[{2, 4}, GenSet[s2, s3, s4]]]

Dimino[GenSet[s2, s3, s4]]

The previous orbit is larger now:

SchreierOrbit[4, GenSet[s2, s3, s4], 7]

And finally we have G^(1), which is generated by the base {1,2,4} and the GS {s1, s2, s3, s4}:

OrderOfGroup[
      StrongGenSet[{1, 2, 4}, GenSet[s1, s2, s3, s4]]]

Dimino[GenSet[s1, s2, s3, s4]]

The orbit is even larger now. This group is regular.

SchreierOrbit[4, GenSet[s1, s2, s3, s4], 7]

Schreier vectors. Note that there are two wrong permutations in the first vector in Butler.

PrintSchreier[SchreierOrbit[B[[1]], chain[[1]], 7]]

PrintSchreier[SchreierOrbit[B[[2]], chain[[2]], 7]]

PrintSchreier[SchreierOrbit[B[[3]], chain[[3]], 7]]

These are examples of membership on page 90 of Butler:

PermMemberQ[Cycles[{1, 2, 3, 4, 5, 6, 7}], SGS]

PermMemberQ[Cycles[{1, 4, 2, 3, 7, 5, 6}], SGS]

PermWord[Cycles[{1, 4, 2, 3, 7, 5, 6}], SGS]

Permute[s3, s4]

PermMemberQ[%, chain[[3]]]

Permute[s2, s3]

PermMemberQ[%, chain[[2]]]

Permute[s1, s1]

PermMemberQ[%, chain[[1]]]

We know check the SGS:

SchreierSims[B, S, 7, xPermVerbose -> True, 
      UseRules -> $xPermRules]

And generate new SGS:

SchreierSims[{1}, GenSet[a, b], 7, xPermVerbose -> True, 
      UseRules -> $xPermRules]

newSGS = 
      SchreierSims[{1, 2, 3, 4, 5, 6, 7}, GenSet[a, b], 7, 
        xPermVerbose -> True]

With the SGS we can test membership:

PermMemberQ[Cycles[], SGS]

PermMemberQ[TranslatePerm[Perm[{6, 4, 2, 1, 7, 5, 3}], Cycles], 
      SGS]

PermMemberQ[TranslatePerm[Perm[{7, 1, 2, 3, 4, 5, 6}], Cycles], 
      SGS]

Or with the new SGS:

PermMemberQ[Cycles[], newSGS]

PermMemberQ[TranslatePerm[Perm[{6, 4, 2, 1, 7, 5, 3}], Cycles], 
      newSGS]

PermMemberQ[TranslatePerm[Perm[{7, 1, 2, 3, 4, 5, 6}], Cycles], 
      newSGS]

Example 3. Mathieu

Example in page 82 of Butler.

s1 = Cycles[{1, 2, 3}, {4, 5, 6}, {7, 8, 9}];

s2 = Cycles[{2, 4, 3, 7}, {5, 6, 9, 8}];

s3 = Cycles[{2, 5, 3, 9}, {4, 8, 7, 6}];

s4 = Cycles[{1, 10}, {4, 5}, {6, 8}, {7, 9}];

s5 = Cycles[{1, 11}, {4, 6}, {5, 9}, {7, 8}];

g1 = 
        TranslatePerm[Perm[{1, 2, 10, 6, 7, 4, 5, 9, 8, 3, 11}], 
          Cycles];
g2 = 
        TranslatePerm[Perm[{1, 2, 4, 10, 9, 3, 8, 5, 7, 6, 11}], 
          Cycles];
g3 = 
        TranslatePerm[Perm[{1, 2, 5, 8, 10, 9, 3, 6, 4, 7, 11}], 
          Cycles];
g4 = 
        TranslatePerm[Perm[{1, 2, 11, 8, 6, 5, 9, 4, 7, 10, 3}], 
          Cycles];
g5 = 
        TranslatePerm[Perm[{1, 2, 3, 7, 8, 9, 4, 5, 6, 11, 10}], 
          Cycles];
g6 = 
        TranslatePerm[Perm[{1, 2, 3, 10, 6, 8, 11, 9, 5, 7, 4}], 
          Cycles];
g7 = 
        TranslatePerm[Perm[{1, 2, 3, 9, 10, 4, 6, 11, 7, 8, 5}], 
          Cycles];

$xPermRules = 
        Join[{Cycles[] -> "ID"}, NameRules[s, 5, Cycles], 
          NameRules[g, 7, Cycles]];

S = GenSet[s1, s2, s3, s4, s5];
B = {11, 10, 1, 2};
SGS = StrongGenSet[B, S];

OrderOfGroup[SGS]

FactorInteger[%]

(chain = StabilizerChain[SGS]) // ColumnForm

There is a wrong permutation in the first vector of Butler:

PrintSchreier[SchreierOrbit[B[[1]], chain[[1]], 11]]

PrintSchreier[SchreierOrbit[B[[2]], chain[[2]], 11]]

PrintSchreier[SchreierOrbit[B[[3]], chain[[3]], 11]]

PrintSchreier[SchreierOrbit[B[[4]], chain[[4]], 11]]

We can check that  {S, B} is actually a SGS:

SchreierSims[B, S, 11, xPermVerbose -> True, 
      UseRules -> $xPermRules]

Or we can give a different SGS:

{junk, newSGS} = Timing[SchreierSims[{}, S, 11]]

DeleteRedundantGenerators[newSGS]

{junk, newSGS} = 
      Timing[SchreierSims[{1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11}, S, 
          11]]

newSGS = DeleteRedundantGenerators[newSGS]

OrderOfGroup[newSGS]

There are also many redundant points:

StabilizerChain[newSGS] // ColumnForm

Example 4

Example in page 82 of Butler.

a = 
        Cycles[{1, 8, 9}, {2, 11, 15}, {3, 10, 12}, {4, 14, 19}, {5, 16, 
            17}, {6, 21, 20}, {7, 13, 18}];

b = Cycles[{9, 18, 20}, {12, 19, 17}];

c = Cycles[{10, 21, 11}, {13, 16, 14}];

s1 = a;
s2 = b;
s3 = c;
s4 = Cycles[{8, 13, 21}, {10, 14, 16}];
s5 = Cycles[{2, 6, 3}, {4, 5, 7}];
s6 = Cycles[{12, 20, 15}, {17, 19, 18}];

g1 = Cycles[{8, 16, 11}, {13, 14, 21}];
g2 = Cycles[{2, 3, 6}, {4, 7, 5}];
g3 = Cycles[{1, 7, 6}, {3, 4, 5}];

B = {1, 9, 8, 10, 2, 12};
S = GenSet[s1, s2, s3, s4, s5, s6];
SGS = StrongGenSet[B, S];

PermDeg[S]

$xPermRules = 
        Join[{Cycles[] -> "ID"}, 
          NameRules[s, 6, Cycles], {g1 -> "g1", g2 -> "g2", 
            g3 -> "g3"}];

OrderOfGroup[SGS]

FactorInteger[%]

(chain = StabilizerChain[SGS]) // ColumnForm

There are only two discrepancies with respect to Butler's result, again in the first vector:

PrintSchreier[SchreierOrbit[B[[1]], chain[[1]], 21]]

PrintSchreier[SchreierOrbit[B[[2]], chain[[2]], 21]]

PrintSchreier[SchreierOrbit[B[[3]], chain[[3]], 21]]

PrintSchreier[SchreierOrbit[B[[4]], chain[[4]], 21]]

PrintSchreier[SchreierOrbit[B[[5]], chain[[5]], 21]]

PrintSchreier[SchreierOrbit[B[[6]], chain[[6]], 21]]

Check SGS.

Timing[
      SchreierSims[B, S, 21, xPermVerbose -> True, 
        UseRules -> $xPermRules]]

Timing[
      SchreierSims[{}, GenSet[a, b, c], 21, xPermVerbose -> True, 
        UseRules -> $xPermRules]]

Example 5. Rubik

Example in page 83 of Butler.

There are 6 basic generators, given by the rotation of each of the faces:

RubikA = 
        Cycles[{1, 3, 8, 6}, {2, 5, 7, 4}, {9, 48, 15, 12}, {10, 47, 16, 
            13}, {11, 46, 17, 14}];

StablePoints[RubikA]

RubikB = 
        Cycles[{6, 15, 35, 26}, {7, 22, 34, 19}, {8, 30, 33, 11}, {12, 14, 
            29, 27}, {13, 21, 28, 20}];

RubikC = 
        Cycles[{1, 12, 33, 41}, {4, 20, 36, 44}, {6, 27, 38, 46}, {9, 11, 26, 
            24}, {10, 19, 25, 18}];

RubikD = 
        Cycles[{1, 24, 40, 17}, {2, 18, 39, 23}, {3, 9, 38, 32}, {41, 43, 48, 
            46}, {42, 45, 47, 44}];

RubikE = 
        Cycles[{3, 43, 35, 14}, {5, 45, 37, 21}, {8, 48, 40, 29}, {15, 17, 
            32, 30}, {16, 23, 31, 22}];

RubikF = 
        Cycles[{24, 27, 30, 43}, {25, 28, 31, 42}, {26, 29, 32, 41}, {33, 35, 
            40, 38}, {34, 37, 39, 36}];

RubikGS = 
        GenSet[RubikA, RubikB, RubikC, RubikD, RubikE, RubikF];

Actually they are all permutations of order 4:

PowerPermute[#, 4] & /@ RubikGS

And @@ ((Cycles[] == PowerPermute[#, 4]) & /@ 
          RubikGS)

There are two 24-points orbits, corresponding to "corners" and "sides":

Orbits[RubikGS, 48]

There are no fully stable points:

Intersection @@ StablePoints /@ RubikGS

For example, assuming that 1 and 2 are next to each other, it is simple to understand why there are 3 rotations that do not move them:

Stabilizer[{1, 2}, RubikGS] === 
      GenSet[RubikB, RubikE, RubikF]

Strong generating set:

RubikBase = {1, 6, 3, 8, 21, 23, 26, 5, 29, 19, 7, 24, 25, 28, 31, 
          18, 4, 2};

s1 = RubikA;
s2 = RubikB;
s3 = RubikE;
s4 = 
        Cycles[{5, 37, 28, 21}, {8, 26, 29, 32}, {14, 33, 35, 40}, {15, 27, 
            30, 43}, {16, 31, 34, 22}];
s5 = 
        Cycles[{5, 45, 13, 37, 21}, {7, 31, 22, 16, 23}, {26, 27, 33}, {29, 
            35, 30}];
s6 = Cycles[{19, 23, 34}, {20, 45, 28}];
s7 = RubikF;
s8 = Cycles[{5, 28, 37}, {16, 34, 31}];
s9 = 
        Cycles[{2, 28, 47, 34}, {24, 41, 38}, {25, 39, 31, 36, 42, 37}, {29, 
            43, 30, 40, 35, 32}];
s10 = 
        Cycles[{19, 31, 34}, {20, 37, 28}];
s11 = Cycles[{7, 31, 34}, {13, 37, 28}];
s12 = 
        Cycles[{24, 41, 38}, {32, 43, 40}];
s13 = 
        Cycles[{24, 40}, {25, 39, 34, 37}, {28, 31, 36, 42}, {32, 38}, {41, 
            43}];
s14 = 
        Cycles[{25, 28, 31}, {34, 37, 36}];
s15 = Cycles[{2, 31, 34}, {28, 47, 37}];
s16 = Cycles[{2, 31, 39}, {37, 42, 47}];
s17 = Cycles[{2, 18, 39}, {42, 47, 44}];
s18 = Cycles[{2, 10, 39}, {4, 42, 47}];
s19 = Cycles[{2, 47}, {39, 42}];

RubikS = 
        GenSet[s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12, s13, s14, 
          s15, s16, s17, s18, s19];

SGS = StrongGenSet[RubikBase, RubikS];

OrderOfGroup[SGS]

N[%]

FactorInteger[%%]

$xPermRules = 
        Join[{Cycles[] -> "ID"}, 
          NameRules[s, 19, Cycles]];

There are no redundant points in the base:

(chain = StabilizerChain[SGS]) // ColumnForm

Check that it is a SGS:

AbsoluteTiming[
      TranslatePerm[
        SchreierSims[RubikBase, RubikS, 48, MathLink -> True], 
        Cycles]]

Example 6

Example in page 84 of Butler.

a = 
        Cycles[{1, 2}, {3, 4}, {5, 6}, {7, 8}, {9, 10}, {11, 
            12}];

b = 
        Cycles[{1, 13}, {2, 3, 7, 5}, {6, 9, 11, 8}, {10, 14}];

s1 = a;
s2 = 
        Cycles[{2, 7}, {3, 5}, {6, 11}, {8, 9}];
s3 = 
        Cycles[{3, 7, 11, 8}, {4, 14}, {5, 6}, {12, 
            13}];
s4 = 
        Cycles[{3, 13, 11, 14}, {4, 8}, {5, 6}, {7, 
            12}];
s5 = Cycles[{4, 12}, {13, 14}];
s6 = Cycles[{7, 8}, {13, 14}];
s7 = Cycles[{5, 6}, {13, 14}];

g1 = 
        TranslatePerm[Perm[{13, 5, 2, 4, 7, 8, 3, 11, 6, 14, 9, 12, 1, 10}], 
          Cycles];
g2 = 
        TranslatePerm[Perm[{1, 4, 11, 2, 13, 14, 8, 7, 12, 10, 3, 9, 5, 6}], 
          Cycles];
g3 = 
        TranslatePerm[Perm[{1, 2, 14, 8, 5, 6, 12, 4, 9, 10, 13, 7, 11, 3}], 
          Cycles];
g4 = 
        TranslatePerm[Perm[{1, 6, 13, 11, 9, 2, 12, 4, 5, 10, 14, 3, 7, 8}], 
          Cycles];
g5 = 
        TranslatePerm[Perm[{1, 2, 3, 12, 5, 6, 8, 7, 9, 10, 11, 4, 13, 14}], 
          Cycles];
g6 = 
        TranslatePerm[Perm[{1, 2, 12, 11, 5, 6, 14, 13, 9, 10, 4, 3, 8, 7}], 
          Cycles];
g7 = 
        TranslatePerm[Perm[{1, 2, 3, 12, 6, 5, 8, 7, 9, 10, 11, 4, 14, 13}], 
          Cycles];
g8 = 
        TranslatePerm[Perm[{1, 2, 3, 4, 6, 5, 8, 7, 9, 10, 11, 12, 13, 14}], 
          Cycles];

B = {1, 2, 3, 4, 7, 5};
S = GenSet[s1, s2, s3, s4, s5, s6, s7];
SGS = StrongGenSet[B, S];

$xPermRules = 
        Join[{Cycles[] -> "ID"}, NameRules[s, 7, Cycles], 
          NameRules[g, 8, Cycles]];

OrderOfGroup[SGS]

(chain = StabilizerChain[SGS]) // ColumnForm

Note that we obtain mostly different vectors compared to those of Butler. His solution is a tree of 8 levels, while the solution given here has 5 levels only:

PrintSchreier[SchreierOrbit[B[[1]], chain[[1]], 14]]

PrintSchreier[SchreierOrbit[B[[2]], chain[[2]], 14]]

PrintSchreier[SchreierOrbit[B[[3]], chain[[3]], 14]]

PrintSchreier[SchreierOrbit[B[[4]], chain[[4]], 14]]

PrintSchreier[SchreierOrbit[B[[5]], chain[[5]], 14]]

PrintSchreier[SchreierOrbit[B[[6]], chain[[6]], 14]]

Example in page 91 of Butler. It's wrong.

Permute[a, b]

Permute @@ PermWord[Permute[a, b], SGS]

Permute @@ {s6, Permute[s4, s3], Permute[s2, s3, s4, s4], 
        Permute[s1, s2, s3]}

Check SGS.

Timing[
      SchreierSims[B, S, 14, xPermVerbose -> True, 
        UseRules -> $xPermRules]]

Timing[
      SchreierSims[{}, GenSet[a, b], 14, xPermVerbose -> True, 
        UseRules -> $xPermRules]]

Example 7

Example in page 85 of Butler:

a = 
        Cycles[{1, 2}, {3, 4}, {5, 6}, {7, 8}, {9, 10}, {11, 12}, {13, 
            14}, {15, 16}];

b = 
        Cycles[{1, 2, 5, 3}, {4, 7}, {6, 9}, {8, 11}, {10, 13, 16, 15}, {12, 
            14}];

s1 = a;
s2 = 
        Cycles[{3, 14, 10, 6}, {4, 5, 9, 13}, {7, 11}, {8, 
            12}];
s3 = 
        Cycles[{2, 6, 10, 14, 11, 7, 3}, {4, 8, 12, 13, 15, 9, 
            5}];
s4 = 
        Cycles[{4, 12}, {6, 11}, {7, 14}, {8, 
            9}];
s5 = Cycles[{4, 8}, {6, 7}, {9, 12}, {11, 14}];

g1 = 
        TranslatePerm[
          Perm[{1, 10, 3, 8, 15, 6, 7, 4, 9, 2, 14, 12, 13, 11, 5, 16}], 
          Cycles];
g2 = 
        TranslatePerm[
          Perm[{1, 2, 11, 5, 12, 3, 14, 9, 13, 7, 6, 4, 8, 10, 15, 16}], 
          Cycles];
g3 = 
        TranslatePerm[
          Perm[{1, 2, 6, 5, 4, 3, 7, 8, 13, 14, 11, 12, 9, 10, 15, 16}], 
          Cycles];
g4 = 
        TranslatePerm[
          Perm[{1, 2, 10, 12, 13, 11, 6, 4, 8, 3, 14, 9, 5, 7, 15, 16}], 
          Cycles];

B = {1, 2, 3, 4};
S = GenSet[s1, s2, s3, s4, s5];
SGS = StrongGenSet[B, S];

$xPermRules = 
        Join[{Cycles[] -> "ID", b -> "b"}, 
          NameRules[s, 5, Cycles], NameRules[g, 4, Cycles]];

Butler quotes a result which is 8 times larger:

OrderOfGroup[SGS]

FactorInteger[%]

Dimino[S] // Length

Timing[
      SchreierSims[B, S, 16, xPermVerbose -> True, 
        UseRules -> $xPermRules]]

Timing[
      SchreierSims[{}, GenSet[a, b], 16, xPermVerbose -> True, 
        UseRules -> $xPermRules]]

Example 8

Example in page 86 of Butler.

a = 
        Cycles[{1, 2}, {3, 4}, {5, 6}, {7, 8}, {9, 10}, {11, 12}, {13, 
            14}, {15, 16}, {17, 18}];

b = 
        Cycles[{1, 2, 5, 3}, {4, 7}, {6, 9, 12, 11}, {8, 13, 16, 15}, {10, 
            14, 18, 17}];

s1 = a;
s2 = 
        Cycles[{2, 10}, {3, 6}, {4, 11}, {5, 17}, {7, 18}, {8, 14}, {9, 
            16}, {12, 13}];
s3 = 
        Cycles[{3, 15, 7, 10, 6, 18, 13}, {4, 8}, {5, 9}, {11, 14}, {16, 
            17}];
s4 = Cycles[{4, 16, 5, 8, 14, 11, 17}];
s5 = Cycles[{5, 14, 8, 16, 11, 17, 9}];
s6 = Cycles[{6, 15, 10, 7, 18, 13, 12}];

g1 = 
      TranslatePerm[
        Perm[{1, 3, 7, 5, 11, 2, 15, 4, 17, 6, 9, 12, 10, 8, 13, 16, 14, 
            18}], Cycles]; 
    g2 = TranslatePerm[
        Perm[{1, 18, 3, 16, 5, 2, 13, 4, 14, 7, 8, 12, 15, 17, 6, 9, 11, 
            10}], Cycles]; 
    g3 = TranslatePerm[
        Perm[{1, 2, 18, 4, 16, 7, 3, 17, 8, 15, 5, 12, 6, 11, 13, 9, 14, 
            10}], Cycles]; 
    g4 = TranslatePerm[
        Perm[{1, 2, 15, 8, 9, 18, 10, 4, 5, 6, 14, 12, 3, 11, 7, 17, 16, 
            13}], Cycles]; 
    g5 = TranslatePerm[
        Perm[{1, 2, 3, 16, 14, 6, 7, 17, 11, 10, 9, 12, 13, 5, 15, 4, 8, 
            18}], Cycles];
g6 = 
      TranslatePerm[
        Perm[{1, 2, 3, 11, 14, 6, 7, 4, 8, 10, 16, 12, 13, 9, 15, 5, 17, 
            18}], Cycles]; 
    g7 = TranslatePerm[
        Perm[{1, 2, 3, 4, 17, 6, 7, 5, 11, 10, 8, 12, 13, 9, 15, 14, 16, 
            18}], Cycles]; 
    g8 = TranslatePerm[
        Perm[{1, 2, 3, 17, 8, 15, 18, 4, 16, 7, 11, 6, 12, 5, 10, 14, 9, 
            13}], Cycles]; 
    g9 = TranslatePerm[
        Perm[{1, 2, 3, 4, 14, 15, 18, 16, 5, 7, 17, 6, 12, 8, 10, 11, 9, 
            13}], Cycles];

B = {1, 2, 3, 4, 5, 6};
S = GenSet[s1, s2, s3, s4, s5, s6];
SGS = StrongGenSet[B, S];

$xPermRules = 
        Join[{Cycles[] -> "ID", b -> "b"}, 
          NameRules[s, 6, Cycles], NameRules[g, 9, Cycles]];

OrderOfGroup[SGS]

FactorInteger[%]

Timing[
      SchreierSims[B, S, 18, xPermVerbose -> True, 
        UseRules -> $xPermRules]]

Timing[
      SchreierSims[{}, GenSet[a, b], 18, xPermVerbose -> True, 
        UseRules -> $xPermRules]]

Example 9

Example in page 86 of Butler.

a = 
        Cycles[{1, 15, 7, 5, 12}, {2, 9, 13, 14, 8}, {3, 6, 10, 11, 
            4}];

b = 
        Cycles[{1, 7}, {2, 11}, {3, 12}, {4, 13}, {5, 10}, {8, 
            14}];

c = 
        Cycles[{1, 16}, {2, 3}, {4, 5}, {6, 7}, {8, 9}, {10, 11}, {12, 
            13}, {14, 15}];

s1 = a;
s2 = 
        Cycles[{2, 4, 6}, {3, 5, 7}, {8, 9}, {10, 13, 14, 11, 12, 
            15}];
s3 = 
        Cycles[{8, 9}, {10, 11}, {12, 13}, {14, 
            15}];
s4 = 
        Cycles[{3, 12, 14}, {4, 10, 6, 7, 9, 5}, {8, 11}, {13, 16, 
            15}];
s5 = 
        Cycles[{3, 12, 14}, {4, 9, 6}, {5, 7, 10}, {13, 16, 
            15}];
s6 = Cycles[{4, 6}, {5, 7}, {12, 14}, {13, 15}];

g1 = 
        TranslatePerm[
          Perm[{1, 2, 3, 5, 4, 7, 6, 10, 11, 8, 9, 15, 14, 13, 12, 16}], 
          Cycles];
g2 = 
        TranslatePerm[
          Perm[{1, 5, 9, 6, 10, 14, 2, 3, 15, 11, 7, 8, 4, 16, 12, 13}], 
          Cycles];
g3 = 
        TranslatePerm[
          Perm[{1, 2, 15, 8, 5, 6, 11, 4, 9, 10, 7, 16, 13, 14, 3, 12}], 
          Cycles];

B = {1, 2, 8, 3, 4};
S = GenSet[s1, s2, s3, s4, s5, s6];
SGS = StrongGenSet[B, S];

$xPermRules = 
        Join[{Cycles[] -> "ID", b -> "b", 
            c -> "c"}, NameRules[s, 6, Cycles], 
          NameRules[g, 3, Cycles]];

OrderOfGroup[SGS]

FactorInteger[%]

Timing[
      SchreierSims[B, S, 16, xPermVerbose -> True, 
        UseRules -> $xPermRules]]

Timing[
      SchreierSims[{}, GenSet[a, b, c], 16, xPermVerbose -> True, 
        UseRules -> $xPermRules]]

Example 10

Example in page 86 of Butler.

a = 
        Cycles[{4, 5}, {6, 8}, {7, 9}, {10, 12}, {13, 16}, {15, 19}, {18, 
            22}, {20, 24}, {23, 27}, {25, 29}, {26, 30}, {28, 
            31}];

b = 
        Cycles[{1, 2, 3, 4, 6}, {5, 7, 10, 13, 17}, {8, 11, 14, 18, 23}, {9, 
            12, 15, 20, 25}, {16, 21, 22, 26, 29}, {19, 24, 28, 31, 
            27}];

s1 = b;
s2 = 
        Cycles[{2, 13}, {3, 18}, {5, 25}, {7, 26}, {9, 31}, {11, 16}, {12, 
            27}, {14, 28}, {15, 22}, {17, 20}, {19, 24}, {21, 
            30}];
s3 = 
        Cycles[{1, 8}, {3, 30, 7, 24}, {9, 28, 17, 22}, {10, 29}, {11, 
            16}, {12, 27}, {14, 31, 15, 20}, {18, 19, 26, 
            21}];
s4 = 
        Cycles[{1, 29}, {8, 10}, {9, 20}, {11, 27}, {12, 16}, {17, 31}, {19, 
            24}, {21, 30}];
s5 = 
        Cycles[{6, 8}, {7, 9}, {13, 16}, {15, 19}, {23, 29}, {25, 27}, {26, 
            31}, {28, 30}];
s6 = 
        Cycles[{6, 29}, {7, 31}, {8, 23}, {9, 26}, {13, 27}, {15, 30}, {16, 
            25}, {19, 28}];
s7 = 
        Cycles[{6, 16}, {7, 19}, {8, 13}, {9, 15}, {23, 27}, {25, 29}, {26, 
            30}, {28, 31}];
s8 = 
        Cycles[{6, 19}, {7, 16}, {8, 15}, {9, 13}, {23, 30}, {25, 31}, {26, 
            27}, {28, 29}];

B = {4, 2, 3, 1, 6};
S = 
        GenSet[s1, s2, s3, s4, s5, s6, s7, s8];
SGS = StrongGenSet[B, S];

$xPermRules = 
        Join[{Cycles[] -> "ID", a -> "a"}, 
          NameRules[s, 8, Cycles]];

OrderOfGroup[SGS]

FactorInteger[%]

Timing[
      SchreierSims[B, S, 31, xPermVerbose -> True, 
        UseRules -> $xPermRules]]

Timing[SchreierSims[{}, GenSet[a, b], 31]]

OrderOfGroup[Last[%], MathLink -> True]

Example 11. Symmetries of the square. Signatures

a = Cycles[{1, 2, 3, 4}, {5, 6}];

b = Cycles[{2, 4}, {5, 6}];

$xPermRules = {Cycles[] -> "ID", a -> "a", 
          b -> "b"};

Dimino[GenSet[a, b]]

We can test membership in G=G^(1):

PermMemberQ[ID, StrongGenSet[{1, 2}, GenSet[a, b]]]

PermMemberQ[Cycles[{5, 6}], 
      StrongGenSet[{1, 2}, GenSet[a, b]]]

PermMemberQ[Permute[a, b], 
      StrongGenSet[{1, 2}, GenSet[a, b]]]

PermMemberQ[Cycles[{1, 2}], 
      StrongGenSet[{1, 2}, GenSet[a, b]]]

And membership in G^(2):

Stabilizer[{1}, GenSet[a, b]] == GenSet[b]

PermMemberQ[a, StrongGenSet[{4}, GenSet[b]]]

PermMemberQ[b, StrongGenSet[{4}, GenSet[b]]]

PermMemberQ[ID, StrongGenSet[{4}, GenSet[b]]]

And membership in G^(3):

PermMemberQ[ID, StrongGenSet[{}, GenSet[]]]

Construction of the pair (base,SGS) from scratch:

SchreierSims[{1}, GenSet[a, b], xPermVerbose -> True, 
      UseRules -> $xPermRules]

OrderOfGroup[StrongGenSet[{1, 2}, GenSet[a, b]]]

Example 11b

With positive signature:

a = Cycles[{1, 2, 3}];

Construction of the pair (base,SGS) from scratch:

SchreierSims[{1}, GenSet[a], xPermVerbose -> True]

Dimino[GenSet[a]]

With negative signature:

a = Cycles[{1, 2, 3}, {4, 5}];

Construction of the pair (base,SGS) from scratch:

SchreierSims[{1}, GenSet[a], xPermVerbose -> True]

Dimino[GenSet[a]]

SchreierSims[{4}, GenSet[a], xPermVerbose -> True]

Example 12. Projective plane of order 2. Signatures

We assign negative signature to our generators:

a = Cycles[{1, 2, 4, 5, 7, 3, 6}, {8, 9}];

b = Cycles[{2, 4}, {3, 5}, {8, 9}];

Now there are two orbits, rather than just one:

Orbits[GenSet[a, b]]

s1 = a;
s2 = b;
s3 = Cycles[{4, 5}, {6, 7}, {8, 9}];
s4 = Cycles[{4, 6}, {5, 7}, {8, 9}];

s5 = Cycles[{4, 7}, {5, 6}, {8, 9}];
s6 = Cycles[{8, 9}];

B = {1, 2, 4};
S = GenSet[s1, s2, s3, s4];
BB = {1, 2, 4, 8};
SS = GenSet[s1, s2, s3, s4, s5, s6];

Order of group:

OrderOfGroup[StrongGenSet[B, S]]

Length[Dimino[S]]

OrderOfGroup[StrongGenSet[BB, SS]]

$xPermRules = 
        Join[{ID[a] -> "ID"}, NameRules[s, 6, Cycles]];

We know check the SGS:

SchreierSims[B, S, xPermVerbose -> True, 
      UseRules -> $xPermRules]

And generate new SGS:

SchreierSims[{8}, GenSet[a, b], xPermVerbose -> True, 
      UseRules -> $xPermRules]

PermMemberQ[Cycles[], StrongGenSet[BB, SS]]

PermMemberQ[Cycles[{8, 9}], StrongGenSet[BB, SS]]

Example 13. Riemann

a = Cycles[{1, 2}, {5, 6}];
b = Cycles[{1, 3}, {2, 4}];

Orbits[GenSet[a, b]]

Dimino[GenSet[a, b]]

Construction of the pair (base,SGS) from scratch:

SGS = 
      SchreierSims[{1}, GenSet[a, b], xPermVerbose -> True]

PermMemberQ[ID, SGS]

PermMemberQ[Cycles[{5, 6}], SGS]

SGS = 
        StrongGenSet[{1, 3}, 
          GenSet[Cycles[{1, 2}, {5, 6}], Cycles[{1, 3}, {2, 4}], 
            Cycles[{3, 4}, {5, 6}]]];

TranslatePerm[
      First@RightCosetRepresentative[Cycles[{1, 3, 2}], 6, SGS], 
      Perm]

SGS = 
        StrongGenSet[{1, 2, 3, 4}, 
          GenSet[Cycles[{1, 2}, {5, 6}], Cycles[{1, 3}, {2, 4}], 
            Cycles[{3, 4}, {5, 6}]]];

TranslatePerm[
      First@RightCosetRepresentative[Cycles[{1, 3, 2}], 6, SGS], 
      Perm]

Example 14

a = Cycles[{1, 2}, {6, 7}];
b = Cycles[{1, 2, 3, 4, 5}, {6, 7}];

Orbits[GenSet[a, b]]

SchreierSims[{}, GenSet[a, b], xPermVerbose -> True]

Length[Dimino[GenSet[a, b]]]