combinatorics problem
- To: mathgroup at smc.vnet.net
- Subject: [mg7514] combinatorics problem
- From: Xah Lee <xah at best.com>
- Date: Tue, 10 Jun 1997 10:48:47 -0400 (EDT)
- Sender: owner-wri-mathgroup at wolfram.com
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.
The following code captures my criteria.
Clear[sameTestQ];
sameTestQ[li1_?PermutationQ,li2_?PermutationQ]:=
Or@@(SameQ[li1,#]&/@
Flatten[{#,Reverse at #}&/@Table[RotateRight[li2,i],{i,Length at li2}],
1])/;(Length at li1==Length@li2)
Ideally, I should get what I want by
Union[Permutation[Range at n], SameTest->sameTestQ]
but that doesn't work. The reason can be seen in the example:
Union[{{2,1,3,4},{3,4,1,2},{3,4,2,1}},SameTest->sameTestQ]
It returns the argument unchanged. The first and last elements are the same,
but wasn't filtered out probably because Union only compare adjacent pairs
after sorting.
I'm working my way using DeleteCases or Select and I'll get it sooner or
later. I'm wondering if you had similar problems and solutions before. It
does looks like the best way is simply try to generate my list directly,
perhaps by writing my own fuction. The problem is then a mathematical one.
The solution answers the question: Given n points in space, in how many ways
can one connect them together to form a loop.
Xah
xah at best.com
http://www.best.com/~xah/SpecialPlaneCurves_dir/specialPlaneCurves.html
Mountain View, CA, USA