       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. 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]

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:= Module[{gens, verts, edges},
gens = PermutationList /@ GroupGenerators@DihedralGroup;
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= {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