Out-Shuffle

Author

Eric W. Weisstein
January 5, 2006

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Games/Out-Shuffle.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/Out-Shuffle.html.

©2006 Wolfram Research, Inc. except for portions noted otherwise

Initialization

For odd n, need

Partition[Range[n],n/2,n/2,1,{}]

But for even n,

Shuffle[l_List]:=Transpose[Partition[l,Length[l]/2]]/;EvenQ[ Length[l]]
Shuffle[n_Integer]:=Shuffle[Range[n]]

InShuffle[l_List]:=Flatten[Reverse/@Shuffle[l]]/;EvenQ[ Length[l]]
OutShuffle[l_List]:=Flatten[Shuffle[l]]/;EvenQ[ Length[l]]
OutShuffle[n_Integer?EvenQ]:=OutShuffle[Range[n]]/;n>0

Out-Shuffle

OutShuffle[8]

OutShuffle[52]

Deck  of 52 cards after multiple inshuffles

OutShuffle[Range[8]]

Select[Range[2,12,2],PrimeQ[#-1]&]

Function[n,{n,Nest[OutShuffle,Range[n],n-2]}]/@Select[Range[2,12,2],PrimeQ[#-1]&]//ColumnForm

Function[n,Nest[OutShuffle,Range[n],n-2]==Range[n]]/@Select[Range[2,100,2],PrimeQ[#-1]&]

And@@%

Outshuffles to return deck to original state

Length[NestWhileList[OutShuffle,Range[52],UnsameQ,All]]-1

Table[Length[NestWhileList[OutShuffle,Range[n],UnsameQ,All]]-1,{n,2,100,2}]

Table[MultiplicativeOrder[2,2n-1],{n,50}]

l=First/@Split[Sort[Table[{MultiplicativeOrder[2,2n-1],n},{n,10^7}]],#1[[1]]==#2[[1]]&];//Timing

max=Position[-Subtract@@@Partition[First/@l,2,1],_?(#>1&),1,1][[1,1]]+1

pos=Last/@Take[l,max]

(#+1)/2&/@(First/@Table[Position[Table[MultiplicativeOrder[2,n],{n,2^k-1}],k,1]//Flatten,{k,20}])//Timing

(#+1)/2&/@(First/@Table[Position[Table[MultiplicativeOrder[2,n],{n,2^k-1}],k,1]//Flatten,{k,25}])//Timing