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$
    – yode
    Commented Jul 8, 2016 at 13:35
  • $\begingroup$ For noncyclic permutations: have you seen Complement[]? $\endgroup$
    – J. M.'s missing motivation ♦
    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$
    – Szabolcs
    Commented Jul 8, 2016 at 14:53

4 Answers 4

Reset to default
13
$\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$
    – Mr.Wizard
    Commented Jul 11, 2016 at 16:31
  • $\begingroup$ Complement is great, thanks for your help $\endgroup$
    – Jojo
    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$
    – yode
    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$
    – Mr.Wizard
    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$
    – Mr.Wizard
    Commented Jul 13, 2016 at 4:35
  • $\begingroup$ I guess my memory does not extend three years back :-/ $\endgroup$
    – Mr.Wizard
    Commented Jul 13, 2016 at 5:01
  • $\begingroup$ I think this is a winning answer. :) $\endgroup$
    – yode
    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$
    – yode
    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$
    – ciao
    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$
    – ciao
    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$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.