faster Rich Guy 's shuffle

[Wouter Meeussen]

for the Mathematica 3.0 cognocenti :

In[]:=
comp=Compile[{{deck,_Integer,1} },le=Length[deck];
 hale=Floor[ le/2 ];Flatten[Transpose[Reverse@(Partition[Append[Append[deck,2 
hale+1],2 hale+2 ], hale+1])]],{{le,_Integer},{hale,_Integer}} ]

Out[]=
  CompiledFunction[{deck}, le = Length[deck]; hale = Floor[le\/2]; 
      Flatten[Transpose[
          Reverse[Partition[Append[Append[deck, 2\ hale + 1], 2\ hale + 2], 
              hale + 1]]]], "-CompiledCode-"] 

In[]:=
Timing[Nest[riguy,{},100]; ]
{0.44 Second}

In[]:=
Timing[Nest[comp,{},100]; ]
{0.27 Second}
**********************************************
card '38' surfaces at turn 22.
card '39' surfaces at turn 13932.

the tough cards (more than 2048 shuffles) are:
{39,43,45,54,55,63,64,65,68,77,78,85,89,103,106,112,118,119,120,127}

at what turns does card "1" come first?
{3,7,50,93,307,832}


the top cards that are new:
{2,3,1,6,5,9,4,16,10,12,14,23,18,20,17,27,30,33,38,37,32,11,19,25,21,34,8,31,
  29,26,7,35,28,24,22,36,13,15}
but it should be edited according to the "start-deck=1" rule into:
{1,2,3,6,5,9,4,16,10,12,14,23,18,20,17,27,30,33,38,37,32,11,19,25,21,34,8,31,
  29,26,7,35,28,24,22,36,13,15}

at what shuffle do we get a "new" top card :
{1,2,3,4,5,6,8,10,11,12,13,14,16,17,18,19,20,21,22,25,26,28,29,32,33,35,37,48,
  57,60,78,97,106,133,210,217,349,383}
but it should be edited according to the "start-deck=1" rule into:
{0,1,2,4,5,6,8,10,11,12,13,14,16,17,18,19,20,21,22,25,26,28,29,32,33,35,37,48,
  57,60,78,97,106,133,210,217,349,383}


have fun,

wouter.
Dr. Wouter L. J. MEEUSSEN
w.meeussen.vdmcc at vandemoortele.be
eu000949 at pophost.eunet.be