Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
1997
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 1997

[Date Index] [Thread Index] [Author Index]

Search the Archive

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


  • Prev by Date: Re: combinatorics p
  • Next by Date: Re: List manipulation
  • Previous by thread: Re: combinatorics problem
  • Next by thread: Re: combinatorics problem