Sheldon Ross 10: Exercise 3.64

Question: A and B roll a pair of dice in turn, with A rolling first. A’s objective is to obtain a sum of 6, and B’s is to obtain a sum of 7. The game ends when either player reaches his or her objective, and that player is declared the winner.

  1. Find the probability that A is the winner
  2. Find the expected number of rolls of the dice
  3. Find the variance of the number of rolls of the dice.

Analytical Solution

Problem Tree: As we can see, the problem flow is fairly straightforward.

  1. P( Ais the winner ) = (536) + (3136) (56) P( Ais the winner ) ⇒ P( Ais the winner ) = (3061) ≅ 0.516667
  2. A rolls
    • A wins End
    • A doesn’t win
      • B rolls
        • B wins End
        • B doesn’t win → A rolls (state 1)

E[ X ] = E[ E[ X | result of game i] ] = E[ X | Awins game 1 ] P{Awins game 1} + E[ X | Aloses game 1 ] P{Aloses game 1}

⇒ E[ X ] = 1*(536) + E[ X | Aloses game 1 ] (3136) = 1*(536) + (1 + E[ X | Outcome of game 2 ] ) (3136)

⇒ E[ X ] = (1 + ( E[ X | Bwins game 2 ] P{Bwins game 2} + E[ X | Bloses game 2 ] P{Bloses game 2} ) ) (3136)

⇒ E[ X ] = (1 + ( 1*(16) + ( 1 + E[ X | Outcome of game 3 ] )(16) ) ) (3136)

⇒ E[ X ] = (1 + ( 16 + ( 1 + E[X] )(16) ) ) (3136)

Solving the linear equation for E[ X ], we get E[ X ] = (40261) ≅ 6.59016


Simulation Solution

The following simulation shows the means of the outcomes of a 1000 simulations, each containing 100 sub-runs. The histograms seem to be peaking above the calculated values from the section above.


Code

I wrote this one in Mathematica. A simple enough method to batch the outcomes. I used 1000 batches of 100 each to find 1000 means values and used that to construct both the histograms in a single chart. Let me know if there are issues with the code.

ClearAll[customMod]
customMod[n_Integer] := If[Divisible[n, 2], 2, 1]

Module[{plotData},
  plotData = Transpose@Table[
    Module[{outcomes, outcomesProbability, runs = 100},
      outcomes = Table[Module[{winner, players = {"A", "B"}},
        Module[{i = 1, range = Range@6, winOutcomes = {6, 7}},
          While[True,

            If[Plus @@ RandomChoice[range, 2] ==
                winOutcomes[[customMod[i]]],
              winner = {i, players[[customMod[i]]]};
              Break[]];
            i += 1;
          ]
        ];
        winner
      ], runs];
      outcomesProbability =
          KeySort@(#[[1]] & /@ # & /@ (GroupBy[outcomes, #[[2]] &]));
      outcomesProbability = N@(Length[outcomesProbability["A"]] / runs);
      outcomes = N@Mean[#[[1]] & /@ outcomes];
      {outcomesProbability, outcomes}
    ], 1000];
  Framed@Histogram[plotData, {0.01}, ImageSize -> 788,
    ChartLegends -> Placed[{"P{A wins}", "E[X]"}, Top], Frame -> True,
    FrameTicks -> {Range[0, 8, 0.5], Automatic}]
]

End of the post 😉