Sheldon Ross 10: Example 4.06 (A Gambling Model)

Question: Consider a gambler who, at each play of the game, either wins $1 with probability p or loses $1 with probability 1 − p. If we suppose that our gambler quits playing either when he goes broke or he attains a fortune of $N, then the gambler’s fortune is a Markov chain having transition probabilities Pi,i+1 = p = 1 − Pi,i−1, i = 1, 2, . . . , N − 1, P00 = PNN = 1 States 0 and N are called absorbing states since once entered they are never left. Note that the preceding is a finite state random walk with absorbing barriers (states 0 and N).


Analytical Solution

N/A


Simulation Solution

We can construct the Transition matrix for Markov Chain choosing N = $15. Notice the absorbing states, at $0 and $15 indicated with a different note than the other states. The graph has been constructed using Wolfram Mathematica.

Simulating this took some effort. There was no way to track the progress of a simulation using “RandomFunction” of Mathematica. So, I wrote a layer of code over the RandomChoice function in order to simulate and track the progress. When the state reaches either one of the absorbing states, i.e., the $0 or $15, the simulation exists out of the While loop and returns the output. The plot below shows the gambler’s path for towards the absorbing states while playing.

The grid also points out the probabilities of winning for every sub-game. Notice that as the probabilities are increasing the paths are biased more towards the winning direction. The text markers indicate the start and the end positions. For this simulation, the players start with $6 in hand and the game ends either when the player has $0 left or obtains a total of $15.


Code

For the graph

Module[{dimensions = 16, transitionMatrix, labels},
  transitionMatrix = ConstantArray[0, ConstantArray[dimensions, 2]];
  Table[If[(i == 1 && j == 1) || (i == dimensions && j == dimensions),
    transitionMatrix[[i, j]] = 1,
    If[((i == j - 1) || (i == j + 1)) && (i != 1) && (i != dimensions),
      transitionMatrix[[i, j]] = 0.5]], {i, 1, dimensions}, {j, 1,
    dimensions}];
  labels =
      "$" <> ToString[#] & /@
          Range[0, Dimensions[transitionMatrix][[1]] - 1];
  labels[[-1]] = labels[[-1]] <> " Win";
  labels[[1]] = labels[[1]] <> " Broke";
  Graph[labels, DiscreteMarkovProcess[1, transitionMatrix],
    GraphLayout -> "CircularEmbedding", ImageSize -> 500] // Framed
]

For the simulation and the plot

Clear[markovSimulator, circlePointsRandomizer, chainObject];
markovSimulator[transitionMatrix_?MatrixQ, currentState_Integer] :=
    Module[{states = Range[Dimensions[transitionMatrix][[1]]]},
      RandomChoice[transitionMatrix[[currentState]] -> states]];

circlePointsRandomizer[n_Integer] :=
    MapThread[{-(1 + #2) Sin[Divide[2 \[Pi] #1, n]], (1 + #2) Cos[
      Divide[2 \[Pi] #1, n]]} &, {Range[n],
      RandomReal[{-0.2, 0.2}, n]}]


chainObject[list_List, totalNodes_Integer] :=
    Module[{perimeter = circlePointsRandomizer[totalNodes],
      circleSubset}, circleSubset = perimeter[[list]];
    {Opacity@0.05, BSplineCurve[circleSubset, SplineDegree -> 2]}
    ]

Grid[Partition[#, 3], Frame -> All, FrameStyle -> Gray] &[
  Table[Module[{dimensions = 16, transitionMatrix, labels, p = prob,
    iterations = 200, simulations = {}},
    transitionMatrix = ConstantArray[0, ConstantArray[dimensions, 2]];
    Table[If[(i == 1 && j == 1) || (i == dimensions &&
        j == dimensions), transitionMatrix[[i, j]] = 1,
      If[(i == j + 1) && (i != dimensions),
        transitionMatrix[[i, j]] = 1 - p,
        If[(i == j - 1) && (i != 1),
          transitionMatrix[[i, j]] = p]]], {i, 1, dimensions}, {j, 1,
      dimensions}];
    labels =
        "$" <> ToString[#] & /@
            Range[0, Dimensions[transitionMatrix][[1]] - 1];
    labels[[-1]] = labels[[-1]] <> " Win";
    labels[[1]] = labels[[1]] <> " Broke";

    Table[Module[{simulation, start = 7},
      simulation = {start};
      While[True,
        start = markovSimulator[transitionMatrix, start];
        AppendTo[simulation, start];
        If[start == 1 || start == 16, Break[]];
      ];
      AppendTo[simulations, simulation];
    ], iterations];

    Graphics[
      {chainObject[#, 16] & /@ simulations,
        Text["p($+) = " <> ToString[p], {0, 0}],
        Text[Rotate[Style["start $6", Red], 0.4 Pi], {-0.3, -0.6}],
        Text[Rotate[Style["win $15", Red], 0.5 Pi], {0, 0.6}],
        Text[Rotate[Style["lose $0", Red], 0.6 Pi], {-0.2, 0.6}]},
      PlotRange -> ConstantArray[{-1.3, 1.3}, 2], ImageSize -> 262]
  ], {prob, Range[0.1, 0.9, 0.1]}]]

 


End of the post 😉


.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.