4
$\begingroup$

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.

$\endgroup$
2
  • $\begingroup$ 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. $\endgroup$
    – flinty
    May 9, 2023 at 11:57
  • $\begingroup$ See this also $\endgroup$
    – flinty
    May 9, 2023 at 17:19

2 Answers 2

2
$\begingroup$

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]
$\endgroup$
0
$\begingroup$

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]]

In your cases:

CanonicalPermutationGroup[g]

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

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.