2

给定一个整数列表，比如{2,1,1,0}我想列出该列表中在给定组下不等价的所有排列。例如，使用正方形的对称性，结果将是{{2, 1, 1, 0}, {2, 1, 0, 1}}。

下面的方法（Mathematica 8）生成所有排列，然后剔除等效的排列。我不能使用它，因为我负担不起生成所有排列，有没有更有效的方法？

更新：实际上，瓶颈在DeleteCases. 以下列表{2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 0, 0, 0}有大约一百万个排列，计算时间为 0.1 秒。显然，消除对称性后应该有 1292 个订单，但我的方法并没有在 10 分钟内完成

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

2 回答 2

0

我从 Maxim Rytin 那里得到了一个优雅而快速的解决方案，依赖于 ConnectedComponents 功能

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
于 2010-12-29T23:47:36.437 回答
0

有什么问题：

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

我没有 Mathematica 8，所以我无法测试这个。我只有 Mathematica 7。

于 2010-12-23T04:39:13.970 回答