Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2010

[Date Index] [Thread Index] [Author Index]

Search the Archive

Counting

  • To: mathgroup at smc.vnet.net
  • Subject: [mg114850] Counting
  • From: Yaroslav Bulatov <yaroslavvb at gmail.com>
  • Date: Mon, 20 Dec 2010 00:40:07 -0500 (EST)

I'd like to count the number of permutations of {2, 2, 2, 2, 2, 2, 2,
1, 1, 0, 0, 0, 0, 0, 0, 0} that are not equivalent under the symmetry
of DihedralGroup[16]. In other words, count the ways of assigning
those integers to vertices of a 4 dimensional cube.

This takes about a minute in another systme using "OrbitsDomain" command. My
Mathematica approach is below, however it doesn't finish within 10
minutes, any advice how to make it tractable?

nonequivalentPermutations[lst_, group_] := (
   removeEquivalent[{}] := {};
   removeEquivalent[list_] := (
     Sow[First[list]];
     equivalents = Permute[First[list], #] & /@ GroupElements[group];
     DeleteCases[list, Alternatives @@ equivalents]
     );

   reaped = Reap@FixedPoint[removeEquivalent, Permutations@lst];
   reaped[[2, 1]] // Length
   );
nonequivalentPermutations[{2, 2, 2, 2, 2, 2, 2, 1, 1, 0, 0, 0, 0, 0,
  0, 0}, DihedralGroup[16]]


  • Prev by Date: Behaviour of Replace
  • Next by Date: Re: bibtex support in Mathematica 8
  • Previous by thread: Re: Behaviour of Replace
  • Next by thread: Re: Counting