8
$\begingroup$

Does anyone knows a way to compute a list of all (p,q)-shuffles in mathematica?

For a definition of the shuffle permutations see for example http://ncatlab.org/nlab/show/shuffle

I'm dreaming of a function with p and q as arguments that gives me:

1.) The number of all (p,q)-shuffles.

2.) A list of the actual "shuffle" (p+q)-permutations

3.) The sign of each such permutation

$\endgroup$
6
  • 1
    $\begingroup$ Let's see if we can do better than this mathhelpforum.com/math-software/… $\endgroup$ May 4, 2012 at 4:24
  • $\begingroup$ Ok. Since this was asked before, I guess there is no such thing. $\endgroup$ May 4, 2012 at 4:33
  • $\begingroup$ But it was not asked here :D $\endgroup$ May 4, 2012 at 4:34
  • $\begingroup$ Is there a package to work with general permutations? Then maybe I can use it as a starting point to write that function by myself. $\endgroup$ May 4, 2012 at 4:47
  • $\begingroup$ Very painfully inefficient: With[{p = 4, q = 5}, Union[Join[Sort[Take[#, p]], Sort[Take[#, -q]]] & /@ Permutations[Range[p + q]]]] $\endgroup$ May 4, 2012 at 4:50

1 Answer 1

9
$\begingroup$

1) The number of all (p,q) shuffles is

Binomial[p+q,p]

since when you chose the first p elements, the whole thing (and its order) is given.

2)The actual shuffles are given by: (See JM's comment below*)

With[{x = Range@#1}, {#, Complement[x, #]} & /@ Subsets[x, {#2}]] &[p + q, p]

Example:

p = 3; q = 2;
With[{x = Range@#1}, {#, Complement[x, #]} & /@ Subsets[x, {#2}]] &[p + q, p]

(*
->
{{{1, 2, 3}, {4, 5}}, {{1, 2, 4}, {3, 5}}, {{1, 2, 5}, {3, 4}}, {{1, 3, 4}, {2, 5}}, 
 {{1, 3, 5}, {2, 4}}, {{1, 4, 5}, {2, 3}}, {{2, 3, 4}, {1, 5}}, {{2, 3, 5}, {1, 4}}, 
 {{2, 4, 5}, {1, 3}}, {{3, 4, 5}, {1, 2}}}

3) The sign of each permutation (for the above shuffles) is given by:

Signature/@ With[{x=Range@#1}, Join[#, Complement[x, #]] & /@ Subsets[x, {#2}]] &[p+q,p]

Example:

p = 3; q = 2;
Signature/@ With[{x=Range@#1}, Join[#, Complement[x, #]] & /@ Subsets[x, {#2}]] &[p+q,p]
(*
-> {1, -1, 1, 1, -1, 1, -1, 1, -1, 1}
*)
$\endgroup$
7
  • $\begingroup$ mmm looking again ... all those p+q looks nasty. Lets see if I can improve $\endgroup$ May 4, 2012 at 5:00
  • $\begingroup$ Signature[] is built-in; no need for an auxiliary package... $\endgroup$ May 4, 2012 at 5:01
  • 1
    $\begingroup$ @J.M. Thanks. I keep using Combinatorica ... old vice. Editing. $\endgroup$ May 4, 2012 at 5:02
  • $\begingroup$ On that note: it might be a bit better if you don't generate Range[p + q] more than once: With[{pq = Range[p + q]}, Join[#, Complement[pq, #]] & /@ Subsets[pq, {p}]]. $\endgroup$ May 4, 2012 at 5:09
  • $\begingroup$ @J.M. yep. I'm trying to keep it as a one liner function of p,q $\endgroup$ May 4, 2012 at 5:11

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.