Perfect shuffle: Difference between revisions

From Rosetta Code
Content added Content deleted
(Added Algol 68)
(→‎{{header|Java}}: added Java)
Line 340: Line 340:


Note that the implementation of <code>shuf</code> defines a behavior for odd length "decks". Experimentation shows that cycle length for an odd length deck is often the same as the cycle length for an even length deck which is one "card" longer.
Note that the implementation of <code>shuf</code> defines a behavior for odd length "decks". Experimentation shows that cycle length for an odd length deck is often the same as the cycle length for an even length deck which is one "card" longer.

=={{header|Java}}==
{{works with|Java|8}}
<lang java>import java.util.stream.IntStream;

public class PerfectShuffle {

public static void main(String[] args) {

int[] sizes = {8, 24, 52, 100, 1020, 1024, 10_000};
for (int size : sizes)
System.out.printf("%5d : %5d%n", size, perfectShuffle(size));
}

static int perfectShuffle(final int size) {
if (size % 2 != 0)
throw new IllegalArgumentException("size must be even");

int[] a = IntStream.range(0, size).toArray();
int half = a.length / 2;
int[] a1 = new int[half];
int[] a2 = new int[half];
int count = 0;

do {
count++;

for (int i = 0; i < half; i++) {
a1[i] = a[i];
a2[i] = a[i + half];
}

for (int i = 0, k = 0; i < size; i += 2, k++) {
a[i] = a1[k];
a[i + 1] = a2[k];
}

} while (!sorted(a));

return count;
}

static boolean sorted(int[] a) {
for (int i = 0; i < a.length; i++)
if (a[i] != i)
return false;
return true;
}
}</lang>

<pre> 8 : 3
24 : 11
52 : 8
100 : 30
1020 : 1018
1024 : 10
10000 : 300</pre>


=={{header|Oforth}}==
=={{header|Oforth}}==

Revision as of 12:32, 24 March 2016

Perfect shuffle is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

A perfect shuffle (or faro/weave shuffle) means splitting a deck of cards into equal halves, and perfectly interleaving them - so that you end up with the first card from the left half, followed by the first card from the right half, and so on:

7♠ 8♠ 9♠ J♠ Q♠ K♠
→
7♠  8♠  9♠
  J♠  Q♠  K♠
→
7♠ J♠ 8♠ Q♠ 9♠ K♠

When you repeatedly perform perfect shuffles on an even-sized deck of unique cards, it will at some point arrive back at its original order. How many shuffles this takes, depends solely on the number of cards in the deck - for example for a deck of eight cards it takes three shuffles:

original:

1 2 3 4 5 6 7 8

after 1st shuffle:

1 5 2 6 3 7 4 8

after 2nd shuffle:

1 3 5 7 2 4 6 8

after 3rd shuffle:

1 2 3 4 5 6 7 8

The Task

  1. Write a function that can perform a perfect shuffle on an even-sized list of values.
  2. Call this function repeatedly to count how many shuffles are needed to get a deck back to its original order, for each of the deck sizes listed under "Test Cases" below.
    • You can use a list of numbers (or anything else that's convenient) to represent a deck; just make sure that all "cards" are unique within each deck.
    • Print out the resulting shuffle counts, to demonstrate that your program passes the test-cases.

Test Cases

input (deck size) output (number of shuffles required)
8 3
24 11
52 8
100 30
1020 1018
1024 10
10000 300

ALGOL 68

<lang algol68># returns an array of the specified length, initialised to an ascending sequence of integers # OP DECK = ( INT length )[]INT: 

    BEGIN
        [ 1 : length ]INT result;
        FOR i TO UPB result DO result[ i ] := i OD;
       result
    END # DECK # ;
  1. in-place shuffles the deck as per the task requirements #
  2. LWB deck is assumed to be 1 #

PROC shuffle = ( REF[]INT deck )VOID: 

    BEGIN
        [ 1 : UPB deck ]INT result;
        INT left pos  := 1;
        INT right pos := ( UPB deck OVER 2 ) + 1;
        FOR i FROM 2 BY 2 TO UPB result DO
            result[ left pos  ] := deck[ i - 1 ];
            result[ right pos ] := deck[ i     ];
            left pos  +:= 1;
            right pos +:= 1
        OD;
        FOR i TO UPB deck DO deck[ i ] := result[ i ] OD
    END # SHUFFLE # ;
  1. compares two integer arrays for equality #

OP = = ( []INT a, b )BOOL: 

    IF LWB a /= LWB b OR UPB a /= UPB b
    THEN # the arrays have different bounds #
        FALSE
    ELSE
        BOOL result := TRUE;
        FOR i FROM LWB a TO UPB a WHILE result := a[ i ] = b[ i ] DO SKIP OD;
        result
    FI # = # ;
  1. compares two integer arrays for inequality #

OP /= = ( []INT a, b )BOOL: NOT ( a = b );

  1. returns the number of shuffles required to return a deck of the specified length #
  2. back to its original state #

PROC count shuffles = ( INT length )INT: 

    BEGIN
        []            INT original deck  = DECK length;
        [ 1 : length ]INT shuffled deck := original deck;
        INT   count         := 1;
        WHILE shuffle( shuffled deck );
              shuffled deck /= original deck
        DO
            count +:= 1
        OD;
        count
    END # count shuffles # ;
  1. test the shuffling #

[]INT lengths = ( 8, 24, 52, 100, 1020, 1024, 10 000 ); FOR l FROM LWB lengths TO UPB lengths DO 

   print( ( whole( lengths[ l ], -8 ) + ": " + whole( count shuffles( lengths[ l ] ), -6 ), newline ) )

OD</lang>

Output:
       8:      3
      24:     11
      52:      8
     100:     30
    1020:   1018
    1024:     10
   10000:    300

C++

<lang cpp>

  1. include <iostream>
  2. include <algorithm>
  3. include <vector>

int pShuffle( int t ) { 

   std::vector<int> v, o, r;

   for( int x = 0; x < t; x++ ) {
       o.push_back( x + 1 );
   }

   r = o;
   int t2 = t / 2 - 1, c = 1;

   while( true ) {
       v = r;
       r.clear();

       for( int x = t2; x > -1; x-- ) {
           r.push_back( v[x + t2 + 1] );
           r.push_back( v[x] );
       }

       std::reverse( r.begin(), r.end() );

       if( std::equal( o.begin(), o.end(), r.begin() ) ) return c;
       c++;
   }

}

int main() { 

   int s[] = { 8, 24, 52, 100, 1020, 1024, 10000 };
   for( int x = 0; x < 7; x++ ) {
       std::cout << "Cards count: " << s[x] << ", shuffles required: ";
       std::cout << pShuffle( s[x] ) << ".\n";
   }
   return 0;

} </lang>

Output:
Cards count: 8, shuffles required: 3.
Cards count: 24, shuffles required: 11.
Cards count: 52, shuffles required: 8.
Cards count: 100, shuffles required: 30.
Cards count: 1020, shuffles required: 1018.
Cards count: 1024, shuffles required: 10.
Cards count: 10000, shuffles required: 300.

EchoLisp

<lang lisp>

shuffler
a permutation vector which interleaves both halves of deck

(define (make-shuffler n) (let ((s (make-vector n))) (for ((i (in-range 0 n 2))) (vector-set! s i (/ i 2))) (for ((i (in-range 0 n 2))) (vector-set! s (1+ i) (+ (/ n 2) (vector-ref s i)))) s))

output
(n . # of shuffles needed to go back)

(define (magic-shuffle n) (when (odd? n) (error "magic-shuffle:odd input" n)) (let [(deck (list->vector (iota n))) ;; (0 1 ... n-1) (dock (list->vector (iota n))) ;; keep trace or init deck (shuffler (make-shuffler n))]

(cons n (1+ (for/sum ((i Infinity)) ; (in-naturals missing in EchoLisp v2.9) (vector-permute! deck shuffler) ;; permutes in place #:break (eqv? deck dock) ;; compare to first 1))))) </lang>

Output:

<lang lisp> map magic-shuffle '(8 24 52 100 1020 1024 10000)) 

   → ((8 . 3) (24 . 11) (52 . 8) (100 . 30) (1020 . 1018) (1024 . 10) (10000 . 300))
Let's look in the On-line Encyclopedia of Integer Sequences
Given a list of numbers, the (oeis ...) function looks for a sequence

(lib 'web) Lib: web.lib loaded. map magic-shuffle (range 2 18 2)) 

   → ((2 . 1) (4 . 2) (6 . 4) (8 . 3) (10 . 6) (12 . 10) (14 . 12) (16 . 4))

(oeis '(1 2 4 3 6 10 12 4)) → Sequence A002326 found </lang>

Haskell

<lang Haskell>module Shuffles 

  where

shuffle :: [a] -> [a] shuffle list = concat ( tupleToList $ zip firstHalf secondHalf ) 

  where
     firstHalf = take ( length list `div` 2 ) list
     secondHalf = drop ( length list `div` 2 ) list
     tupleToList :: [(a , a )] -> a
     tupleToList pairs = map (\p -> [fst p , snd p] ) pairs

shufflenumbers :: Int -> Int shufflenumbers n = length ( takeWhile ( /= [1..n] ) $ tail ( iterate shuffle [1..n] ) ) + 1

printLine :: Int -> IO ( ) printLine n = do 

  putStrLn ( "deck of " ++ show n ++ " cards: " ++ show ( shufflenumbers n ) ++ " shuffles!")

main :: IO( ) main = do 

  numbers <- return [ 8, 24, 52, 100, 1020, 1024, 10000 ]
  sequence_ $ map printLine numbers

</lang>

Output:
deck of 8 cards: 3 shuffles!
deck of 24 cards: 11 shuffles!
deck of 52 cards: 8 shuffles!
deck of 100 cards: 30 shuffles!
deck of 1020 cards: 1018 shuffles!
deck of 1024 cards: 10 shuffles!
deck of 10000 cards: 300 shuffles!

J

The shuffle routine:

<lang J> shuf=: /: $ /:@$ 0 1"_</lang>

Here, the phrase ($ $ 0 1"_) would generate a sequence of 0s and 1s the same length as the argument sequence:

<lang J> ($ $ 0 1"_) 'abcdef' 0 1 0 1 0 1</lang>

And we can use grade up (/:) to find the indices which would sort the argument sequence so that the values in the positions corresponding to our generated zeros would come before the values in the positions corresponding to our ones.

<lang J> /: ($ $ 0 1"_) 'abcdef' 0 2 4 1 3 5</lang>

But we can use grade up again to find what would have been the original permutation (grade up is a self inverting function for this domain).

<lang J> /:/: ($ $ 0 1"_) 'abcdef' 0 3 1 4 2 5</lang>

And, that means it can also sort the original sequence into that order:

<lang J> shuf 'abcdef' adbecf 

  shuf 'abcdefgh'

aebfcgdh</lang>

And this will work for sequences of arbitrary length.

(The rest of the implementation of shuf is pure syntactic sugar - you can use J's dissect and trace facilities to see the details if you are trying to learn the language.)

Meanwhile, the cycle length routine could look like this:

<lang J> shuflen=: [: *./ #@>@C.@shuf@i.</lang>

Here, we first generate a list of integers of the required length in their natural order. We then reorder them using our shuf function, find the cycles which result, find the lengths of each of these cycles then find the least common multiple of those lengths.

So here is the task example (with most of the middle trimmed out to avoid crashing the rosettacode wiki implementation):

<lang J> shuflen"0 }.2*i.5000 1 2 4 3 6 10 12 4 8 18 6 11 20 18 28 5 10 12 36 12 20 14 12 23 21 8 52 20 18 ... 4278 816 222 1332 384</lang>

Task example:

<lang J> ('deck size';'required shuffles'),(; shuflen)&> 8 24 52 100 1020 1024 10000 ┌─────────┬─────────────────┐ │deck size│required shuffles│ ├─────────┼─────────────────┤ │8 │3 │ ├─────────┼─────────────────┤ │24 │11 │ ├─────────┼─────────────────┤ │52 │8 │ ├─────────┼─────────────────┤ │100 │30 │ ├─────────┼─────────────────┤ │1020 │1018 │ ├─────────┼─────────────────┤ │1024 │10 │ ├─────────┼─────────────────┤ │10000 │300 │ └─────────┴─────────────────┘</lang>

Note that the implementation of shuf defines a behavior for odd length "decks". Experimentation shows that cycle length for an odd length deck is often the same as the cycle length for an even length deck which is one "card" longer.

Java

Works with: Java version 8

<lang java>import java.util.stream.IntStream;

public class PerfectShuffle { 

   public static void main(String[] args) {

       int[] sizes = {8, 24, 52, 100, 1020, 1024, 10_000};
       for (int size : sizes)
           System.out.printf("%5d : %5d%n", size, perfectShuffle(size));
   }

   static int perfectShuffle(final int size) {
       if (size % 2 != 0)
           throw new IllegalArgumentException("size must be even");

       int[] a = IntStream.range(0, size).toArray();
       int half = a.length / 2;
       int[] a1 = new int[half];
       int[] a2 = new int[half];
       int count = 0;

       do {
           count++;

           for (int i = 0; i < half; i++) {
               a1[i] = a[i];
               a2[i] = a[i + half];
           }

           for (int i = 0, k = 0; i < size; i += 2, k++) {
               a[i] = a1[k];
               a[i + 1] = a2[k];
           }

       } while (!sorted(a));

       return count;
   }

   static boolean sorted(int[] a) {
       for (int i = 0; i < a.length; i++)
           if (a[i] != i)
               return false;
       return true;
   }

}</lang> 

    8 :     3
   24 :    11
   52 :     8
  100 :    30
 1020 :  1018
 1024 :    10
10000 :   300

Oforth

<lang oforth>: shuffle(l) { l size 2 / dup l left swap l right zip expand }

nbShuffles(l) { 1 l while( shuffle dup l <> ) [ swap 1 + swap ] drop }</lang>
Output:
>[ 8, 24, 52, 100, 1020, 1024, 10000 ] map(#[ seq nbShuffles ]) .
[3, 11, 8, 30, 1018, 10, 300] ok

PARI/GP

This example is in need of improvement:

The task description was updated; please update this solution accordingly and then remove this template.

<lang parigp>magic(v)=vector(#v,i,v[if(i%2,1,#v/2)+i\2]); shuffles_slow(n)=my(v=[1..n],o=v,s=1);while((v=magic(v))!=o,s++);s; shuffles(n)=znorder(Mod(2,n-1)); vector(5000,n,shuffles_slow(2*n))</lang>

Output:
%1 = [1, 2, 4, 3, 6, 10, 12, 4, 8, 18, 6, 11, 20, 18, 28, 5, 10, 12, 36, 12,
 20, 14, 12, 23, 21, 8, 52, 20, 18, 58, 60, 6, 12, 66, 22, 35, 9, 20, 30, 39, 54
, 82, 8, 28, 11, 12, 10, 36, 48, 30, 100, 51, 12, 106, 36, 36, 28, 44, 12, 24, 1
10, 20, 100, 7, 14, 130, 18, 36, 68, 138, 46, 60, 28, 42, 148, 15, 24, 20, 52, 5
2, 33, 162, 20, 83, 156, 18, 172, 60, 58, 178, 180, 60, 36, 40, 18, 95, 96, 12,
196, 99, 66, 84, 20, 66, 90, 210, 70, 28, 15, 18, 24, 37, 60, 226, 76, 30, 29, 9
2, 78, 119, 24, 162, 84, 36, 82, 50, 110, 8, 16, 36, 84, 131, 52, 22, 268, 135,
12, 20, 92, 30, 70, 94, 36, 60, 136, 48, 292, 116, 90, 132, 42, 100, 60, 102, 10
2, 155, 156, 12, 316, 140, 106, 72, 60, 36, 69, 30, 36, 132, 21, 28, 10, 147, 44
, 346, 348, 36, 88, 140, 24, 179, 342, 110, 36, 183, 60, 156, 372, 100, 84, 378,
 14, 191, 60, 42, 388, 88, 130, 156, 44, 18, 200, 60, 108, 180, 204, 68, 174, 16
4, 138, 418, 420, 138, 40, 60, 60, 43, 72, 28, 198, 73, 42, 442, 44, 148, 224, 2
0, 30, 12, 76, 72, 460, 231, 20, 466, 66, 52, 70, 180, 156, 239, 36, 66, 48, 243
, 162, 490, 56, 60, 105, 166, 166, 251, 100, 156, 508, 9, 18, 204, 230, 172, 260
, 522, 60, 40, 253, 174, 60, 212, 178, 210, 540, 180, 36, 546, 60, 252, 39, 36,
556, 84, 40, 562, 28, 54, 284, 114, 190, 220, 144, 96, 246, 260, 12, 586, 90, 19
6, 148, 24, 198, 299, 25, 66, 220, 303, 84, 276, 612, 20, 154, 618, 198, 33, 500
, 90, 72, 45, 210, 28, 84, 210, 64, 214, 28, 323, 290, 30, 652, 260, 18, 658, 66
0, 24, 36, 308, 74, 60, 48, 180, 676, 48, 226, 22, 68, 76, 156, 230, 30, 276, 40
, 58, 700, 36, 92, 300, 708, 78, 55, 60, 238, 359, 51, 24, 140, 121, 486, 56, 24
4, 84, 330, 246, 36, 371, 148, 246, 318, 375, 50, 60, 756, 110, 380, 36, 24, 348
, 384, 16, 772, 20, 36, 180, 70, 252, 52, 786, 262, 84, 60, 52, 796, 184, 66, 90
, 132, 268, 404, 270, 270, 324, 126, 12, 820, 411, 20, 826, 828, 92, 168, 332, 9
0, 419, 812, 70, 156, 330, 94, 396, 852, 36, 428, 858, 60, 431, 172, 136, 390, 1
32, 48, 300, 876, 292, 55, 882, 116, 443, 21, 270, 414, 356, 132, 140, 104,[+++]

(By default gp won't show more than 25 lines of output, though an arbitrary amount can be printed or written to a file; use print, write, or default(lines, 100) to show more.)

Perl

<lang perl>use List::Util qw(all);

sub perfect_shuffle { 

  my $mid = @_ / 2;
  map { @_[$_, $_ + $mid] } 0..($mid - 1);

}

for my $size (8, 24, 52, 100, 1020, 1024, 10000) { 

   my @shuffled = my @deck = 1 .. $size;
   my $n = 0;
   do { $n++; @shuffled = perfect_shuffle(@shuffled) }
       until all { $shuffled[$_] == $deck[$_] } 0..$#shuffled;
   
   printf "%5d cards: %4d\n", $size, $n;

}</lang>

Output:
    8 cards:    3
   24 cards:   11
   52 cards:    8
  100 cards:   30
 1020 cards: 1018
 1024 cards:   10
10000 cards:  300

Perl 6

Translation of: Perl

<lang perl6>sub perfect-shuffle (@deck) { 

   my $mid = @deck / 2;
   flat @deck[0 ..^ $mid] Z @deck[$mid .. *];

}

for 8, 24, 52, 100, 1020, 1024, 10000 -> $size { 

   my @deck = ^$size;
   my $n;
   repeat until [<] @deck {
       $n++;
       @deck = perfect-shuffle @deck;
   }

   printf "%5d cards: %4d\n", $size, $n;

}</lang>

Output:
    8 cards:    3
   24 cards:   11
   52 cards:    8
  100 cards:   30
 1020 cards: 1018
 1024 cards:   10
10000 cards:  300

Python

<lang python> import doctest import random


def flatten(lst): 

   """
   >>> flatten([[3,2],[1,2]])
   [3, 2, 1, 2]
   """
   return [i for sublst in lst for i in sublst]

def magic_shuffle(deck): 

   """
   >>> magic_shuffle([1,2,3,4])
   [1, 3, 2, 4]
   """
   half = len(deck) // 2 
   return flatten(zip(deck[:half], deck[half:]))

def after_how_many_is_equal(shuffle_type,start,end): 

   """
   >>> after_how_many_is_equal(magic_shuffle,[1,2,3,4],[1,2,3,4])
   2
   """

   start = shuffle_type(start)
   counter = 1
   while start != end:
       start = shuffle_type(start)
       counter += 1
   return counter

def main(): 

   doctest.testmod()

   print("Length of the deck of cards | Perfect shuffles needed to obtain the same deck back")
   for length in (8, 24, 52, 100, 1020, 1024, 10000):
       deck = list(range(length))
       shuffles_needed = after_how_many_is_equal(magic_shuffle,deck,deck)
       print("{} | {}".format(length,shuffles_needed))


if __name__ == "__main__": 

   main()

</lang> Reversed shuffle or just calculate how many shuffles are needed: <lang python>def mul_ord2(n): # directly calculate how many shuffles are needed to restore # initial order: 2^o mod(n-1) == 1 if n == 2: return 1

n,t,o = n-1,2,1 while t != 1: t,o = (t*2)%n,o+1 return o

def shuffles(n): a,c = list(range(n)), 0 b = a

while True: # Reverse shuffle; a[i] can be taken as the current # position of the card with value i. This is faster. a = a[0:n:2] + a[1:n:2] c += 1 if b == a: break return c

for n in range(2, 10000, 2): #print(n, mul_ord2(n)) print(n, shuffles(n))</lang>

Racket

<lang racket>#lang racket/base (require racket/list)

(define (perfect-shuffle l) 

 (define-values (as bs) (split-at l (/ (length l) 2)))
 (foldr (λ (a b d) (list* a b d)) null as bs))

(define (perfect-shuffles-needed n) 

 (define-values (_ rv)
   (for/fold ((d (perfect-shuffle (range n))) (i 1))
             ((_ (in-naturals))
              #:break (apply < d))
     (values (perfect-shuffle d) (add1 i))))
 rv)

(module+ test 

 (require rackunit)
 (check-equal? (perfect-shuffle '(1 2 3 4)) '(1 3 2 4))
 
 (define (test-perfect-shuffles-needed n e)
   (define psn (perfect-shuffles-needed n))
   (printf "Deck size:\t~a\tShuffles needed:\t~a\t(~a)~%" n psn e)
   (check-equal? psn e))

 (for-each test-perfect-shuffles-needed
           '(8 24 52 100 1020 1024 10000)
           '(3 11  8  30 1018   10   300)))</lang>
Output:
Deck size:	8	Shuffles needed:	3	(3)
Deck size:	24	Shuffles needed:	11	(11)
Deck size:	52	Shuffles needed:	8	(8)
Deck size:	100	Shuffles needed:	30	(30)
Deck size:	1020	Shuffles needed:	1018	(1018)
Deck size:	1024	Shuffles needed:	10	(10)
Deck size:	10000	Shuffles needed:	300	(300)

REXX

unoptimized

<lang rexx>/*REXX program does a "perfect shuffle" for a number of even numbered decks.*/ parse arg X /*optional list of test cases from C.L.*/ if X= then X=8 24 52 100 1020 1024 10000 /*Not specified? Use default.*/ w=length(word(X, words(X))) /*used for right─aligning the numbers. */ 

   do j=1  for words(X);  y=word(X,j) /*use numbers in the test suite (list).*/

     do k=1  for y;       @.k=k;       end       /*generate a deck to be used*/
     do t=1  until eq();  call magic;  end       /*shuffle 'til before=after.*/

   say 'deck size:'    right(y,w)","       right(t,w)      'perfect shuffles.'
   end   /*j*/

exit /*stick a fork in it, we're all done. */ /*──────────────────────────────────EQ subroutine─────────────────────────────*/ eq: do ?=1 for y; if @.?\==? then return 0; end; return 1 /*──────────────────────────────────MAGIC subroutine──────────────────────────*/ magic: z=0 /*set the Z pointer (used as index).*/ h=y%2 /*get the half─way (midpoint) pointer. */ 

      do s=1  for h;  z=z+1;  h=h+1   /*traipse through the card deck pips.  */
      !.z=@.s;        z=z+1           /*assign left half; then bump pointer. */
      !.z=@.h                         /*   "   right  "                      */
      end   /*s*/                     /*perform a perfect shuffle of the deck*/

      do r=1  for y;  @.r=!.r;  end   /*re─assign to the original card deck. */

return</lang> output (abbreviated) when using the default input: 

deck size:     8,     3 perfect shuffles.
deck size:    24,    11 perfect shuffles.
deck size:    52,     8 perfect shuffles.
deck size:   100,    30 perfect shuffles.
deck size:  1020,  1018 perfect shuffles.
deck size:  1024,    10 perfect shuffles.
deck size: 10000,   300 perfect shuffles.

optimized

This REXX version takes advantage that the 1st and last cards of the deck don't change. <lang rexx>/*REXX program does a "perfect shuffle" for a number of even numbered decks.*/ parse arg X /*optional list of test cases from C.L.*/ if X= then X=8 24 52 100 1020 1024 10000 /*Not specified? Use default.*/ w=length(word(X, words(X))) /*used for right─aligning the numbers. */ 

   do j=1  for words(X);  y=word(X,j) /*use numbers in the test suite (list).*/

     do k=1  for y;       @.k=k;       end       /*generate a deck to be used*/
     do t=1  until eq();  call magic;  end       /*shuffle 'til before=after.*/

   say 'deck size:'    right(y,w)","       right(t,w)      'perfect shuffles.'
   end     /*j*/

exit /*stick a fork in it, we're all done. */ /*──────────────────────────────────EQ subroutine─────────────────────────────*/ eq: do ?=1 for y; if @.?\==? then return 0; end; return 1 /*──────────────────────────────────MAGIC subroutine──────────────────────────*/ magic: z=1; h=y%2 /*set Z & H (half─way) pointers.*/ 

 do L=3  by 2  for h-1; z=z+1; !.L=@.z; end  /*assign left half of the deck. */
 do R=2  by 2  for h-1; h=h+1; !.R=@.h; end  /*   "   right  "   "  "    "   */
 do a=2        for y-2;        @.a=!.a; end  /*re─assign to the original deck*/

return</lang> output is the same as the 1st version.

Ruby

This example is in need of improvement:

The task description was updated; please update this solution accordingly and then remove this template.

<lang ruby>def perfect_shuffle(n) 

 start = *1..n
 deck = start.dup
 m = n / 2
 magic_shuffle = ->(d){ d.shift(m).zip(d).flatten }
 1.step do |i|
   deck = magic_shuffle[deck]
   return i if deck == start
 end

end

fmt = "%4d -%5d :" + "%5d" * 20 (2..10000).step(2).each_slice(20) do |ary| 

 puts fmt % [*ary.minmax, *ary.map{|n| perfect_shuffle(n)}]

end</lang>

Output:
   2 -   40 :    1    2    4    3    6   10   12    4    8   18    6   11   20   18   28    5   10   12   36   12
  42 -   80 :   20   14   12   23   21    8   52   20   18   58   60    6   12   66   22   35    9   20   30   39
  82 -  120 :   54   82    8   28   11   12   10   36   48   30  100   51   12  106   36   36   28   44   12   24
 122 -  160 :  110   20  100    7   14  130   18   36   68  138   46   60   28   42  148   15   24   20   52   52
 162 -  200 :   33  162   20   83  156   18  172   60   58  178  180   60   36   40   18   95   96   12  196   99
 202 -  240 :   66   84   20   66   90  210   70   28   15   18   24   37   60  226   76   30   29   92   78  119
 242 -  280 :   24  162   84   36   82   50  110    8   16   36   84  131   52   22  268  135   12   20   92   30
 282 -  320 :   70   94   36   60  136   48  292  116   90  132   42  100   60  102  102  155  156   12  316  140
 322 -  360 :  106   72   60   36   69   30   36  132   21   28   10  147   44  346  348   36   88  140   24  179
 362 -  400 :  342  110   36  183   60  156  372  100   84  378   14  191   60   42  388   88  130  156   44   18
 402 -  440 :  200   60  108  180  204   68  174  164  138  418  420  138   40   60   60   43   72   28  198   73
 442 -  480 :   42  442   44  148  224   20   30   12   76   72  460  231   20  466   66   52   70  180  156  239
 482 -  520 :   36   66   48  243  162  490   56   60  105  166  166  251  100  156  508    9   18  204  230  172
 522 -  560 :  260  522   60   40  253  174   60  212  178  210  540  180   36  546   60  252   39   36  556   84
 562 -  600 :   40  562   28   54  284  114  190  220  144   96  246  260   12  586   90  196  148   24  198  299
  .
  .
  .
9602 - 9640 : 2400  240   56  492 3202 4116 9612   64 4698 9618 1068  283  300 1604 9628 1605  468  460  418  216
9642 - 9680 :  155 9642  428 4380  402  804  588 3860  252 4452 9660  644  644 1380 1460 4572  568  420 9676 4839
9682 - 9720 : 1380 4620  444 1076 4844  110 3222  276 2424  780  396  780 1292  456   18  492 4410  924  780   43
9722 - 9760 :  810  462 1940 2380 1518 4716 9732  580  636 3246  760 4871 1948  342 9748  693  650 3900 4430 3252
9762 - 9800 : 1582 1500   60 4883 1221  814   84  440 1086  210  652 1086  612 3262  300 4895  699  652 1200 2380
9802 - 9840 : 2970 9802  468 1398  144 3270 1090   60 1636 3270  660 2070  260 1580 1404   28 4916  420 1092 4919
9842 - 9880 :  756   96 1780  532  462 9850 4814   36 4928 9858 1548 2112 1972  660 4830 4935  822 3900  984  396
9882 - 9920 :  120 9882 1316 4943  140  156 1140 3956 3298 2340 9900  660  564 9906 1098  520  473  660 4830   36
9922 - 9960 : 3306 9922  220  174  292 3310  210 3972  522  828 9940 1620   24  588 9948  530 2412  180 3318  792
9962 -10000 :  237 1620  996 4983 3322 4524 3324  180 4530 2344 3324 4884 1996 1664 4278  816  222 1332  384  300


Sidef

Translation of: Perl

<lang ruby>func perfect_shuffle(deck) { 

    var mid = deck.len/2;
    deck.ft(0, mid-1).zip(deck.ft(mid)).flatten;

}

[8, 24, 52, 100, 1020, 1024, 10000].each { |size| 

   var deck = 1..size;
   var shuffled = deck;

   var n = 0;
   loop {
       ++n;
       shuffled = perfect_shuffle(shuffled);

       shuffled.each_index { |i|
           shuffled[i] == deck[i] || goto :NEXT;
       }

       break;
       @:NEXT;
   }

   printf("%5d cards: %4d\n", size, n);

}</lang>

Output:
    8 cards:    3
   24 cards:   11
   52 cards:    8
  100 cards:   30
 1020 cards: 1018
 1024 cards:   10
10000 cards:  300

Tcl

Using tcltest to include an executable test case ..

<lang Tcl>namespace eval shuffle { 

   proc perfect {deck} {
       if {[llength $deck]%2} {
           return -code error "Deck must be of even length!"
       }
       set split [expr {[llength $deck]/2}]
       set top [lrange $deck 0 $split-1]
       set btm [lrange $deck $split end]
       foreach a $top b $btm {
           lappend res $a $b
       }
       return $res
   }

   proc cycle_length {transform deck} {
       set d $deck
       while 1 {
           set d [$transform $d]
           incr i
           if {$d eq $deck} {return $i}
       }
       return $i
   }

   proc range {a {b ""}} {
       if {$b eq ""} {
           set b $a; set a 0
       }
       set res {}
       while {$a < $b} {
           lappend res $a
           incr a
       }
       return $res
   }

}

set ::argv {} package require tcltest tcltest::test "Test perfect shuffle cycles" {} -body { 

   lmap size {8 24 52 100 1020 1024 10000} {
       shuffle::cycle_length perfect [range $size]
   }

} -result {3 11 8 30 1018 10 300}</lang>

zkl

<lang zkl>fcn perfectShuffle(numCards){ 

  deck,shuffle,n,N:=numCards.pump(List),deck,0,numCards/2;
  do{ shuffle=shuffle[0,N].zip(shuffle[N,*]).flatten(); n+=1 }
  while(deck!=shuffle);
  n

} foreach n in (T(8,24,52,100,1020,1024,10000)){ 

  println("%5d : %d".fmt(n,perfectShuffle(n)));

}</lang>

Output:
    8 : 3
   24 : 11
   52 : 8
  100 : 30
 1020 : 1018
 1024 : 10
10000 : 300
Retrieved from "https://rosettacode.org/wiki/Perfect_shuffle?oldid=256577"