4
$\begingroup$

Consider:

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

True

This means there is a redundant generator in the group g1. Maple has a function, NonRedundantGenerators, to deal with this. I can get the group without a redundant generator in MMA like this:

PermutationGroup[SelectFirst[Subsets[GroupGenerators[g1]], PermutationGroup[#] == g1 &]]

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

But when there are too many generated elements, like this group:

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

this method does not work anymore. Is there another way?

$\endgroup$
2
  • $\begingroup$ Accidentally found GroupTheory`PermutationGroups`DeleteRedundantGenerators thought it could be useful (don't know how to use it :), needs 3 arguments). Also, be aware wrong input will crash your kernel. $\endgroup$
    – Ben Izd
    May 27, 2022 at 8:59
  • $\begingroup$ @BenIzd It's a good information deserved to dig $\endgroup$
    – yode
    May 27, 2022 at 18:08

1 Answer 1

6
$\begingroup$

Here is a quick and dirty attempt to solve your problem. delCycshould delete redundant cycles:

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

delCyc[g_] := Module[{t = g[[1]],tmp},
  If[PermutationGroup[t] == PermutationGroup[tmp = DeleteCases[t, #]],
      t = tmp] & /@ t;
  PermutationGroup[t]
  ]

To test if it works:

delCyc[g1]
(* PermutationGroup[{Cycles[{{1, 10}, {2, 11}, {3, 12}, {4, 7}, {5, 
     8}, {6, 9}}], Cycles[{{1, 3}, {4, 6}, {7, 9}, {10, 12}}]}] *)

And with your large example G:

delCyc[G]
(* PermutationGroup[{Cycles[{{2, 20}, {3, 19}, {4, 18}, {5, 17}, {6, 
     16}, {7, 15}, {8, 14}, {9, 13}, {10, 12}}], 
  Cycles[{{1, 20}, {2, 19}, {3, 18}, {4, 17}, {5, 16}, {6, 15}, {7, 
     14}, {8, 13}, {9, 12}, {10, 11}}]}] *)
$\endgroup$
4
  • $\begingroup$ Are you wolfram staff? Can you help to read this comment above? $\endgroup$
    – yode
    May 27, 2022 at 10:27
  • $\begingroup$ No, I am a normal user. Which comment do you mean? $\endgroup$ May 27, 2022 at 11:45
  • $\begingroup$ About GroupTheory`PermutationGroups`DeleteRedundantGenerators above, but I don't know how to use it. Maybe faster. :) $\endgroup$
    – yode
    May 27, 2022 at 11:53
  • $\begingroup$ Sorry, I do not have any inside info. And DeleteRedundantGeneratorsseems an undocumented function. $\endgroup$ May 27, 2022 at 12:18

Your Answer

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

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