8
$\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?

$\endgroup$
  • 4
    $\begingroup$ Permute[#, CyclicGroup[Length@#]] & $\endgroup$ – yode Jul 8 '16 at 13:35
  • $\begingroup$ For noncyclic permutations: have you seen Complement[]? $\endgroup$ – J. M. is away Jul 8 '16 at 13:44
  • 1
    $\begingroup$ @yode Please post an answer. I did not remember that Permute can work with a group. $\endgroup$ – Szabolcs Jul 8 '16 at 14:53
9
$\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}}

$\endgroup$
  • $\begingroup$ Sadly Permute[#, CyclicGroup[Length@#]] & proves to be orders of magnitude slower than what the OP started with! :-( $\endgroup$ – Mr.Wizard Jul 11 '16 at 16:31
  • $\begingroup$ Complement is great, thanks for your help $\endgroup$ – Joe Jul 12 '16 at 13:09
  • $\begingroup$ @Mr.Wizard The CyclicPermutations just do one calculation to get a list.But the cy do n times... $\endgroup$ – yode Jul 12 '16 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 Jul 12 '16 at 22:41
8
$\begingroup$
cp=HankelMatrix[#, RotateRight@#] &;

Should perform quite well and returns packed array...

$\endgroup$
  • $\begingroup$ Great! I never remember these specialized generators. This clearly should be the Accepted answer. $\endgroup$ – Mr.Wizard Jul 13 '16 at 4:35
  • $\begingroup$ I guess my memory does not extend three years back :-/ $\endgroup$ – Mr.Wizard Jul 13 '16 at 5:01
  • $\begingroup$ I think this is a winning answer. :) $\endgroup$ – yode Jul 13 '16 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 Jul 13 '16 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 Jul 13 '16 at 6:22
3
$\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.

$\endgroup$
  • $\begingroup$ I accept the challenge... ;-} $\endgroup$ – ciao Jul 12 '16 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.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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