The Riffle Shuffle

To riffle shuffle a card deck means breaking the deck in two and interleaving the cards from the two halves. If perfomed perfectly, there are two possibilities: (a) top card of the deck remains on top; (b) second card goes to the top. We'll assume here that a riffle shuffle corresponds to (a). Therefore, in a riffle shuffle, cards 1, 2, 3, ...,26 move to positions 1, 3, 5,...51 and cards 27, 28, ..., 52 move to positions 2, 4, ...,52. To begin with, we'll consider the 52 cards as identified by number.

ls = Range[52]

shuffle1[
        lst_List] := Partition[lst, Length[lst]/2] // 
          Transpose//(Flatten[#, 
              1] &)  (*Flatten by itself would work here but we are going to use a representation below of cards as lists of the form {h, 2} (for the two of hearts),  
          and we won' 
            t want to Flatten out lists at this level.*)

shuffle1[ls]

We look now at the effects of repeated riffle shuffles. We know the top card remains on top, but let's see how long it takes for the second card to return to second place.  First note that the effect of 3 successive riffle shuffles can be modelled by

Nest[shuffle1, ls, 3]

Here is a first "non-functional" attempt.

\(waitfor2[ls_] := 
      Module[{ls2 = ls\  (*\ start\ with\ original\ deck*) , 
          n = 0\  (*count\ number\ of\ shuffles*) }, 
		Do[
          ls2 = shuffle1[ls2]; 
	\ \ \(n++\); 
		If[ls2[\([2]\)] == 2, 
            Break[]], {100}]; 
			n]\)

Here is a better functional method.

betterwaitfor2[lst_List] := 
      NestWhile[({#[[1]] + 1, shuffle1[#[[2]]]} &), {1, 
            shuffle1[lst]}, (#[[2, 2]] != 2 &)] // First

Note how the function being nested works:

({#[[1]] + 1, shuffle1[#[[2]]]} &)@{0, ls}

betterwaitfor2[ls]

Seems incredible!!! only 8 riffle shuffles for the second card to come back to second place. Let's check this.

Nest[shuffle1, ls, 8]

Even more incredible, the entire deck is back in its intial state after 8 perfect riffle shuffles. (Magicians know this.)

Now deal 5 cards to each of 4 people after 3 shuffles and look for inequities. We're going to investigate the chances of two pairs in the hands. First of all, if we deal a hand of 5 cards, the probability that it contains exactly 2 pairs is:

Binomial[13, 2]  Binomial [4, 2]^2 44/Binomial[52, 5]

N[%]

Suppose we shuffle 3 times, then cut deck, then deal. Compute number of hands in which first player to left of dealer (4 players) gets 2 pairs. There are in effect only 52 different possible hands, which we examine for 2 pairs. The first player gets cards 1,5,9,13,17 from the shuffled deck. We now model the deck as ordered pairs of a suit and a denomination.

\(\(\(
\)\(suits = {h, s, d, c}\)\)\)

denoms = {Range[2, 10], {J, Q, K, A}} // Flatten

deck = Outer[List, suits, denoms] // (Flatten[#, 1] &)

shdeck = Nest[shuffle1, deck, 3]

hands = 
      Table[RotateRight[shdeck, i] // (Partition[#, 4] &) // 
              Transpose // 
            First // (Take[#, 5] &), 
{i, 1, 
          52}]

To find the number of hands with exactly 2 pairs, we define a function that (a) lists the number of cards of each denomination, discards 0s, sorts and finds those matching the pattern 2,2,1.

cnt[ha_List] := 
      Select[Sort[Table[Count[ha, {_, denoms[[i]]}], {i, 1, 13}], 
          Greater], #1 > 0 &]

cnt[{{d, 2}, {h, 3}, {d, 3}, {h, 4}, {d, 4}}]

cnt[{{h, 4}, {h, J}, {s, 5}, {s, Q}, {d, 6}}]

Select[hands, cnt[#1] == {2, 2, 1} &]

Map[cnt, hands]

Sort[Map[cnt, hands]]

Count[%, {2, 2, 1}]