Permutations distinct under given symmetry (Mathematica 8 group theory)

Question

Given a list of integers like {2,1,1,0} I'd like to list all permutations of that list that are not equivalent under given group. For instance, using symmetry of the square, the result would be {{2, 1, 1, 0}, {2, 1, 0, 1}}.

Approach below (Mathematica 8) generates all permutations, then weeds out the equivalent ones. I can't use it because I can't afford to generate all permutations, is there a more efficient way?

Update: actually, the bottleneck is in DeleteCases. The following list {2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 0, 0, 0} has about a million permutations and takes 0.1 seconds to compute. Apparently there are supposed to be 1292 orderings after removing symmetries, but my approach doesn't finish in 10 minutes

removeEquivalent[{}] := {};
removeEquivalent[list_] := (
   Sow[First[list]];
   equivalents = Permute[First[list], #] & /@ GroupElements[group];
   DeleteCases[list, Alternatives @@ equivalents]
   );
nonequivalentPermutations[list_] := (
   reaped = Reap@FixedPoint[removeEquivalent, Permutations@list];
   reaped[[2, 1]]
   );

group = DihedralGroup[4];
nonequivalentPermutations[{2, 1, 1, 0}]

It feels a little like index canonicalization. Maybe you can get some ideas from (eg) http://arxiv.org/abs/0803.0862 - especially the discussion of component indices. — Simon, Dec 19 '10 at 22:26
OK, maybe my specific problem is easier than general, list all permutations of 16-element list equivalent under DihedralGroup[16], apparently "GAP" can do it — Yaroslav Bulatov, Dec 20 '10 at 03:31

score 0 · Answer 1 · answered Dec 23 '10 at 04:39

0

What's wrong with:

nonequivalentPermutations[list_,group_]:= Union[Permute[list,#]& /@ GroupElements[group];
nonequivalentPermutations[{2,1,1,0},DihedralGroup[4]]

I don't have Mathematica 8, so I can't test this. I just have Mathematica 7.

answered Dec 23 '10 at 04:39

John

5,735
3
46
62

too slow to work on {2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 0, 0, 0} – Yaroslav Bulatov Dec 23 '10 at 05:06
Really? Slower than what you had? Hard to believe. Sucks that I don't have 8 so I can check it out myself. Do you need an enumerated list? Or just the count? There are ways to get the count that are very fast. Have you looked at Burnside's lemma? – John Dec 23 '10 at 08:17
I got a solid 0.0029 seconds on a MacBook for {2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 0, 0, 0} and DihedralGroup[16] but there are only ~30 permutations in the list that is generated. – Timo Dec 23 '10 at 21:07
yeah, that's not right, there should be roughly 30,030 entries in the list. – John Dec 24 '10 at 03:46
Yeah, my code above is crap. It isn't doing the right thing. – John Dec 24 '10 at 04:01

score 0 · Accepted Answer · answered Dec 29 '10 at 23:47

I got an elegant and fast solution from Maxim Rytin, relying on ConnectedComponents function

Module[{gens, verts, edges},
 gens = PermutationList /@ GroupGenerators@DihedralGroup[16];
 verts =
  Permutations@{2, 2, 2, 2, 2, 2, 2, 1, 1, 0, 0, 0, 0, 0, 0, 0};
 edges = Join @@ (Transpose@{verts, verts[[All, #]]} &) /@ gens;
 Length@ConnectedComponents@Graph[Rule @@@ Union@edges]] // Timing

Permutations distinct under given symmetry (Mathematica 8 group theory)

2 Answers2