# How to find a set of generators with the smallest number of elements in a permutation group?

Given a permutation group with many generators

g=PermutationGroup[{Cycles[{}],Cycles[{{3,5,7}}],Cycles[{{3,7,5}}],Cycles[{{2,3},{5,7}}],Cycles[{{2,3,5}}],Cycles[{{2,3,7}}],Cycles[{{2,5,3}}],Cycles[{{2,5,7}}],Cycles[{{2,5},{3,7}}],Cycles[{{2,7,3}}],Cycles[{{2,7,5}}],Cycles[{{2,7},{3,5}}],Cycles[{{1,2},{5,7}}],Cycles[{{1,2},{3,5}}],Cycles[{{1,2},{3,7}}],Cycles[{{1,2,3}}],Cycles[{{1,2,3,5,7}}],Cycles[{{1,2,3,7,5}}],Cycles[{{1,2,5,7,3}}],Cycles[{{1,2,5}}],Cycles[{{1,2,5,3,7}}],Cycles[{{1,2,7,5,3}}],Cycles[{{1,2,7}}],Cycles[{{1,2,7,3,5}}],Cycles[{{1,3,2}}],Cycles[{{1,3,5,7,2}}],Cycles[{{1,3,7,5,2}}],Cycles[{{1,3},{5,7}}],Cycles[{{1,3,5}}],Cycles[{{1,3,7}}],Cycles[{{1,3},{2,5}}],Cycles[{{1,3,2,5,7}}],Cycles[{{1,3,7,2,5}}],Cycles[{{1,3},{2,7}}],Cycles[{{1,3,2,7,5}}],Cycles[{{1,3,5,2,7}}],Cycles[{{1,5,7,3,2}}],Cycles[{{1,5,2}}],Cycles[{{1,5,3,7,2}}],Cycles[{{1,5,3}}],Cycles[{{1,5,7}}],Cycles[{{1,5},{3,7}}],Cycles[{{1,5,7,2,3}}],Cycles[{{1,5},{2,3}}],Cycles[{{1,5,2,3,7}}],Cycles[{{1,5,2,7,3}}],Cycles[{{1,5,3,2,7}}],Cycles[{{1,5},{2,7}}],Cycles[{{1,7,5,3,2}}],Cycles[{{1,7,2}}],Cycles[{{1,7,3,5,2}}],Cycles[{{1,7,3}}],Cycles[{{1,7,5}}],Cycles[{{1,7},{3,5}}],Cycles[{{1,7,5,2,3}}],Cycles[{{1,7},{2,3}}],Cycles[{{1,7,2,3,5}}],Cycles[{{1,7,2,5,3}}],Cycles[{{1,7,3,2,5}}],Cycles[{{1,7},{2,5}}]}];

GroupGenerators[g] gives a set of generator with many redundant elements. In fact, g can be generated with {Cycles[{{1, 5, 7}}], Cycles[{{5, 2, 3}}]}.

g == PermutationGroup[{Cycles[{{1, 5, 7}}], Cycles[{{5, 2, 3}}]}]

How can I find {Cycles[{{1, 5, 7}}], Cycles[{{5, 2, 3}}]} in mathematica? Hope to see a method as fast as possible.

• I believe you need the Schreier-Sims algorithm. See this and it should be able to come up with a set of minimal generators in polynomial time. Kind of complicated to implement though. May 9, 2023 at 11:57
• See this also May 9, 2023 at 17:19

This method randomly shuffles the group elements and then goes through them, adding an element only if it is not reachable from the group so far. I run this many times with different shuffles and choose the list of generators with a small LeafCount.

reduceGroupAttempt[g_] :=
Module[{
elements = RandomSample@GroupElements@g,
dictionary = CreateDataStructure["DynamicArray"]},
dictionary["Append", elements[[1]]];
Do[
If[! GroupElementQ[PermutationGroup[Normal[dictionary]], e],
dictionary["Append", e]], {e, elements}
];
GroupGenerators@PermutationGroup@Normal@dictionary
]

reduced = First@MinimalBy[Table[reduceGroupAttempt[g], {50}], LeafCount]
h = PermutationGroup[reduced];

isomorphicGroupsQ[group1_, group2_] :=
Length[ResourceFunction["FindGroupIsomorphism"][group1, group2, 1]] == 1

isomorphicGroupsQ[g, h]

Look this post, and use this function directly:

CanonicalPermutationGroup[G_] :=
Module[{gens = GroupGenerators[G], tmp},
If[PermutationGroup[gens] ==
PermutationGroup[tmp = DeleteCases[gens, #]], gens = tmp] & /@
gens; PermutationGroup[gens]]