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