MathGroup Archive 2010

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

Search the Archive

Re: Counting

  • To: mathgroup at smc.vnet.net
  • Subject: [mg115007] Re: Counting
  • From: Maxim <m.r at inbox.ru>
  • Date: Tue, 28 Dec 2010 06:49:49 -0500 (EST)
  • References: <iemq7u$m7e$1@smc.vnet.net>

On Dec 19, 11:40 pm, Yaroslav Bulatov <yarosla... at gmail.com> wrote:
> 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]]

Conceptually, the code that you want is Length@GroupOrbits[group,
Permutations@lst, Permute]. This isn't going to be very efficient
though (I believe it will be improved in future versions of
Mathematica). Here's a brute force approach:

In[1]:= 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

Out[1]= {10.578, 12940}

Maxim Rytin
m.r at inbox.ru


  • Prev by Date: Circular neighborhood for ImageApply
  • Next by Date: Re: Wolfram does not support Mathematica 8.0 on SUN OS
  • Previous by thread: Re: Counting
  • Next by thread: Mathematica daily WTF