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