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}には約100万の順列があり、計算に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

どうしたの：

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

私はMathematica8を持っていないので、これをテストすることはできません。私はMathematica7を持っています。

于 2010-12-23T04:39:13.970 に答える
0

ConnectedComponents関数に依存して、MaximRytinからエレガントで高速なソリューションを入手しました

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 に答える