Sheldon Ross 10: Exercise 3.34

Sheldon Ross 10 Exercise 3.34_kill the 6_2.jpg

Question: A set of n dice is thrown. All those that land on six are put aside, and the others are again thrown. This is repeated until all the dice have landed on six. Let N denote the number of throws needed. (For instance, suppose that n = 3 and that on the initial throw exactly two of the dice land on six. Then the other die will be thrown, and if it lands on six, then N = 2.) Let mn = E[N].

  1. Derive a recursive formula for mn and use it to calculate mi, i = 2, 3, 4 and to show that m5 ≈ 13.024

Simulation Solution

Simulation wise, this is a little tricky as in we need to keep track of the dice lost at each of the stages as we keep eliminating them through the cycles. To simplify, I have used Mathematica’s “delayed set” (which is symbolically written as x := 2 where x is evaluated every time). After you roll the initial set of dice, delete the 6s from the set and count the number of elements left after the 6s are removed. You would now have a new number of dice to roll. Keep doing this until you get a set that is zero in length. You could use the code provided below to numerically calculate the m5 value.

The following is the plot for the number of turns taken vs the number of dice we initially started the rolling with.


The code for the above diagram is pasted below. Let me know if you have any issues working with it.

problem3034[rangeIn_ : 6, numberIn_ : 10, iterations_] :=
    Module[{turns = {}, range = Range[rangeIn], number = numberIn},
        {dice := RandomChoice[range], rolls, turn},
        rolls = Table[dice, number];
        turn = 0;
        While[Length@rolls > 0,
          rolls = DeleteCases[rolls, 6];
          rolls = Table[dice, Length@rolls];
          turn += 1;
        AppendTo[turns, turn];
      ], iterations];

Module[{sets = {1, 2, 5, 10, 20, 25, 40, 50, 100}},
  DistributionChart[Table[problem3034[6, n, 10000], {n, sets}],
    ChartElementFunction -> "SmoothDensity", ImageSize -> 788,
    ChartLabels -> ("n = " <> ToString[#] & /@ sets),
    PlotRange -> {Automatic, {0, 60}}]


End of the post 😀