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 at 8:59
  • $\begingroup$ @BenIzd It's a good information deserved to dig $\endgroup$
    – yode
    May 27 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 at 10:27
  • $\begingroup$ No, I am a normal user. Which comment do you mean? $\endgroup$ May 27 at 11:45
  • $\begingroup$ About GroupTheory`PermutationGroups`DeleteRedundantGenerators above, but I don't know how to use it. Maybe faster. :) $\endgroup$
    – yode
    May 27 at 11:53
  • $\begingroup$ Sorry, I do not have any inside info. And DeleteRedundantGeneratorsseems an undocumented function. $\endgroup$ May 27 at 12:18

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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