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
mathematica
|abstract-algebra
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