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