Permutations distinct under given symmetry (Mathematica 8 group theory)

Posted by Yaroslav Bulatov on Stack Overflow See other posts from Stack Overflow or by Yaroslav Bulatov
Published on 2010-12-19T07:04:45Z Indexed on 2010/12/29 23:54 UTC
Read the original article Hit count: 216

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

© Stack Overflow or respective owner

Related posts about mathematica

Related posts about abstract-algebra