11
$\begingroup$

Mathematica has a built in function to generate all permutations of a given list of elements; Permutations

I can't find an equivalent function to generate cyclic permutations only in the documentation. Here is my function that achieves this goal:

CyclicPermutations[list_] := RotateRight[list, #] & /@ (Range[Length[list]] - 1)

Is there an in-built function somewhere that I've not been able to find?

And then a similar question which I don't have my own answer to. I would like to also generate all noncyclic permutations, ie. the set of permutations minus the set of cyclic permutations. I'm not sure of a good way to do this, I can think up some methods which use Permutations and my CyclicPermutations and then maybe DeleteCases, but I think this will be comparatively very inefficient. Does anyone else have a better method?

Improve this question
$\endgroup$
3
  • 5
    $\begingroup$ Permute[#, CyclicGroup[Length@#]] & $\endgroup$ Commented Jul 8, 2016 at 13:35
  • $\begingroup$ For noncyclic permutations: have you seen Complement[]? $\endgroup$ Commented Jul 8, 2016 at 13:44
  • 1
    $\begingroup$ @yode Please post an answer. I did not remember that Permute can work with a group. $\endgroup$ Commented Jul 8, 2016 at 14:53

4 Answers 4

Reset to default
14
$\begingroup$

Per the request, I post my comment as an answer:

First question

cy := Permute[#, CyclicGroup[Length@#]] & cy[Range@5]

{{1, 2, 3, 4, 5}, {2, 3, 4, 5, 1}, {3, 4, 5, 1, 2}, {4, 5, 1, 2,3}, {5, 1, 2, 3, 4}}

Second question

We can use the Complement mentioned by J.M. in his comment. I suppose that the order is $5$; then, you can use the following method to get noncyclic permutations:

Complement[Permutations[Range[5]], cy[Range@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},<<101>>,{5,3,4,2,1},{5,4,1,2,3},{5,4,1,3,2},{5,4,2,1,3},{5,4,2,3,1},{5,4,3,1,2},{5,4,3,2,1}}

Improve this answer
$\endgroup$
4
  • $\begingroup$ Sadly Permute[#, CyclicGroup[Length@#]] & proves to be orders of magnitude slower than what the OP started with! :-( $\endgroup$ Commented Jul 11, 2016 at 16:31
  • $\begingroup$ Complement is great, thanks for your help $\endgroup$ Commented Jul 12, 2016 at 13:09
  • $\begingroup$ @Mr.Wizard The CyclicPermutations just do one calculation to get a list.But the cy do n times... $\endgroup$ Commented Jul 12, 2016 at 13:30
  • $\begingroup$ CyclicPermutations[Range@5] returns {{1, 2, 3, 4, 5}, {5, 1, 2, 3, 4}, {4, 5, 1, 2, 3}, {3, 4, 5, 1, 2}, {2, 3, 4, 5, 1}}. How is Permute better here? $\endgroup$ Commented Jul 12, 2016 at 22:41
9
$\begingroup$ 
cp=HankelMatrix[#, RotateRight@#] &;

Should perform quite well and returns packed array...

Improve this answer
$\endgroup$
10
  • $\begingroup$ Great! I never remember these specialized generators. This clearly should be the Accepted answer. $\endgroup$ Commented Jul 13, 2016 at 4:35
  • $\begingroup$ I guess my memory does not extend three years back :-/ $\endgroup$ Commented Jul 13, 2016 at 5:01
  • $\begingroup$ I think this is a winning answer. :) $\endgroup$ Commented Jul 13, 2016 at 5:07
  • $\begingroup$ But note my cy can be used by cy[{2, 7, 9}],which make life ease in some case.Of course,it out of this topic. $\endgroup$ Commented Jul 13, 2016 at 5:10
  • 1
    $\begingroup$ @Mr.Wizard - sure, I'll gather/clean and put as answer to the "elegant array operations" (or whatever it's called) question when I have time. Remind me if I forget. $\endgroup$ Commented Jul 13, 2016 at 6:22
4
$\begingroup$

At least in version 10.1 under Windows there is a performance problem with yode's Permute solution. For comparison here is his code, Joe's original code, and a variation of my own:

fn1[list_] := RotateRight[list, #] & /@ (Range[Length[list]] - 1) fn2 = Permute[#, CyclicGroup[Length@#]] &; fn3[a_] := Array[RotateLeft[a, #]&, Length @ a]

The results are all equivalent under sorting:

Sort @ # @ Range @ 4 & /@ {fn1, fn2, fn3} 
{{{1, 2, 3, 4}, {2, 3, 4, 1}, {3, 4, 1, 2}, {4, 1, 2, 3}}, {{1, 2, 3, 4}, {2, 3, 4, 1}, {3, 4, 1, 2}, {4, 1, 2, 3}}, {{1, 2, 3, 4}, {2, 3, 4, 1}, {3, 4, 1, 2}, {4, 1, 2, 3}}}

The performance however is not!

AbsoluteTiming @ Timing @ Do[#@Range@500, {50}] & /@ {fn1, fn2, fn3} // Column 
 {0.046702, {0.0312002, Null}} {2.48765, {2.44922, Null}} {0.0456291, {0.0156001, Null}}

Permute on CyclicGroup is some fifty times slower than the other methods here.

My fn3 is just a hair faster than fn1 and IMHO somewhat cleaner, so it is my proposal.

Improve this answer
$\endgroup$
1
  • $\begingroup$ I accept the challenge... ;-} $\endgroup$ Commented Jul 12, 2016 at 23:44
1
$\begingroup$

A few more ... The first one using Partition not too horribly slow

fn4[a_] := Partition[a, Length@a, 1, {1, 1}] fn5[a_] := ListConvolve[{1}, a, #] & /@ a fn6[a_] := ArrayPad[a, {1, -1} (# - 1), "Periodic"] & /@ a fn4@Range@4

{{1, 2, 3, 4}, {2, 3, 4, 1}, {3, 4, 1, 2}, {4, 1, 2, 3}}

Equal @@ (Sort@#@Range@4 & /@ {fn1, fn2, fn3, fn4, fn5, fn6})

True

First@AbsoluteTiming@Do[#@Range@500, {50}] & /@ {fn0, fn1, fn2, fn3, fn4, fn5, fn6} // TableForm[#, TableHeadings -> {{"fn0", "fn1", "fn2", "fn3", "fn4", "fn5", "fn6"}, None}] &

enter image description here

where fn0[a_] := HankelMatrix[a, RotateRight@a] is from ciao's answer.

Improve this answer
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.