Frustration Solitaire

Frustration solitaire is a game that has roots stemming from the early 1700's. The rules of the game are simple: a dealer calls out the ranks of cards in order $\textit{Ace, Two, Three, . . .}$ and so on. At the same time the dealer draws a card from a sufficiently well shuffled deck. If the rank of the card drawn matches the rank of the card the dealer says you lose the game.

The rank of the cards the dealer would have called out are $\textit{Ace, Two, Three, Four, Five}$. Since the fifth card has rank five we lose. Let's programme a game of frustration solitaire. We start by creating an array that corresponds to the ranks of the cards the dealer calls out.

dealer = Flatten[Table[Range[1, 13], 4]]

Next, we need to simulate a well shuffled deck of cards. Using the function RandomSample[] we can easily "shuffle" the deck of cards.

shuffle = RandomSample[Flatten[Table[Range[1, 13], 4]]]

Combine the lists using Transpose[] to get our very own game of frustration solitaire.

In[1]:= fs = 
Transpose[{Flatten[Table[Range[1, 13], 4]], 
RandomSample[Flatten[Table[Range[1, 13], 4]]]}]

Out[1]= {{1, 11}, {2, 9}, {3, 8}, {4, 9}, {5, 8}, {6, 5}, {7, 9}, {8,
6}, {9, 5}, {10, 2}, {11, 4}, {12, 13}, {13, 5}, {1, 10}, {2, 
7}, {3, 12}, {4, 13}, {5, 1}, {6, 12}, {7, 4}, {8, 1}, {9, 2}, {10, 
7}, {11, 10}, {12, 13}, {13, 10}, {1, 8}, {2, 3}, {3, 9}, {4, 
11}, {5, 3}, {6, 3}, {7, 10}, {8, 8}, {9, 6}, {10, 5}, {11, 2}, {12,
7}, {13, 11}, {1, 12}, {2, 12}, {3, 6}, {4, 3}, {5, 1}, {6, 1}, {7,
7}, {8, 2}, {9, 13}, {10, 4}, {11, 6}, {12, 4}, {13, 11}}

Lets see if we have won:

In[2]:= w1 = 
  If[Part[fs[[#]], 1] == Part[fs[[#]], 2], 1, 0] & /@ 
   Range[Length[fs]];

In[3]:= If[Length[DeleteCases[0]@w1] == 0, 
 "YOU WIN!", "YOU LOSE."]


Out[3]= "YOU LOSE"

Now we shouldn't feel too bad about losing. The name "frustration" solitaire stems from the fact that the percentage of winning is actually very low. In 2009, Doyle et. al. found out that the percentage of winning a game of frustration solitaire is approximately $1.62\%$. They worked this out by framing the question within the world of combinatorics. Finding the percentage of winning a game of frustration solitaire is equivalent to finding the number of rank derangements (i.e. how many permutations that have no rank-fixed points) divided by $52!$ (i.e. the total number of permutations of a deck of cards).

Let's generate 100,000 games of frustration solitaire and see how close we can get to the estimate Doyle et. al. produced.

In[4]:= trials = 
  Table[s = 
    Transpose[{Flatten[Table[Range[1, 13], 4]], 
      RandomSample[Flatten[Table[Range[1, 13], 4]]]}]; 
   If[Length[
      DeleteCases[
       If[Part[s[[#]], 1] == Part[s[[#]], 2], 1, 0] & /@ 
        Range[Length[s]], 0]] == 0, 0, 1], 100000];

In[5]:= winning = (1 - Total[trials]/100000)*100// N

Out[5]= 1.61

In our 100,000 games of frustration solitaire we won $1.61\%$ of the time, hence the title of "frustration" solitaire is very well deserved.