Re: combinatorics problem

*To*: mathgroup at smc.vnet.net*Subject*: [mg7552] Re: [mg7514] combinatorics problem*From*: Daniel Lichtblau <danl>*Date*: Fri, 13 Jun 1997 19:37:57 -0400 (EDT)*Sender*: owner-wri-mathgroup at wolfram.com

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. > > 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 It seems that for every "equivalence class" there is exactly one element that is a list whose first entry is 1. Hence it may be faster, not to mention easier to code, to simply generate all permutations of 2..n and then prepend 1 to each. For example: In[52]:= reducedPerms[n_] := Map[Prepend[#,1]&, Permutations[Range[2,n]]] In[53]:= reducedPerms[5] Out[53]= {{1, 2, 3, 4, 5}, {1, 2, 3, 5, 4}, {1, 2, 4, 3, 5}, {1, 2, 4, 5, 3}, > {1, 2, 5, 3, 4}, {1, 2, 5, 4, 3}, {1, 3, 2, 4, 5}, {1, 3, 2, 5, 4}, > {1, 3, 4, 2, 5}, {1, 3, 4, 5, 2}, {1, 3, 5, 2, 4}, {1, 3, 5, 4, 2}, > {1, 4, 2, 3, 5}, {1, 4, 2, 5, 3}, {1, 4, 3, 2, 5}, {1, 4, 3, 5, 2}, > {1, 4, 5, 2, 3}, {1, 4, 5, 3, 2}, {1, 5, 2, 3, 4}, {1, 5, 2, 4, 3}, > {1, 5, 3, 2, 4}, {1, 5, 3, 4, 2}, {1, 5, 4, 2, 3}, {1, 5, 4, 3, 2}} It is in fact the case that Union only compares adjacent elements after sorting. This limitation is well known (at least to us). I do not know offhand if or when it will be addressed, though. Daniel Lichtblau Wolfram Research danl at wolfram.com