Re: combinatorics problem

*To*: mathgroup at smc.vnet.net*Subject*: [mg7553] Re: [mg7514] combinatorics problem*From*: "C. Woll" <carlw at u.washington.edu>*Date*: Fri, 13 Jun 1997 19:38:03 -0400 (EDT)*Sender*: owner-wri-mathgroup at wolfram.com

On Tue, 10 Jun 1997, Xah Lee wrote: > A combinatorics related programing problem. > > I have a list Permutations[Range[n]]. I want to reduce the list by the > following criteria: > > (1) Two lists are considered the same if one is the other shifted. > (RotateRight). > > (2) Two lists are considered the same if one is the other reversed. > > ... Hi Xah, How about the following approach. Define a function which generates a canonical form for each loop: canon[a_?PermutationQ] := Module[{len = Length[a], i1 = Position[a,1][[1,1]], i2 = Position[a,2][[1,1]]}, If[ Mod[ i2-i1, len ] < len/2, RotateLeft[a,i1-1], Reverse[RotateRight[a,len-i1] ] ] The above function converts a loop specification into a canonical form, which is described by starting with 1, and then going in the direction where 2 is reached first. Now, let's apply this function on your example > ... > > Union[{{2,1,3,4},{3,4,1,2},{3,4,2,1}},SameTest->sameTestQ] > > ... Union[ canon /@ {{2,1,3,4},{3,4,1,2},{3,4,2,1}} ] which returns {{1,2,3,4},{1,2,4,3}} In terms of canon, your test function could be written sametestQ[a_?PermutationQ,b_?PermutationQ]:=canon[a]===canon[b] Of course, generating all the loops by doing something like Union[ canon /@ Permutations[Range[n]] ] will become slow very quickly. Also, there may be a canned routine which does this for you in DiscreteMath`Combinatorica`, for example, something along the lines of HamiltonianCycle. Carl