Перестановки, различающиеся при заданной симметрии (теория групп Mathematica 8) - PullRequest
Новая
       57

Перестановки, различающиеся при заданной симметрии (теория групп Mathematica 8)

2 голосов
/ 19 декабря 2010

Учитывая список целых чисел, таких как {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}]

Ответы [ 2 ]

0 голосов
/ 30 декабря 2010

Я получил изящное и быстрое решение от Максима Рытина, полагаясь на функцию 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
0 голосов
/ 23 декабря 2010

Что не так с: 

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

У меня нет Mathematica 8, поэтому я не могу проверить это.У меня просто есть Mathematica 7.

...