Sheldon Ross 10: Example 4.03

Question:  On any given day Gary is either cheerful (C), so-so (S), or glum (G). If he is cheerful today, then he will be C, S, or G tomorrow with respective probabilities 0.5, 0.4, 0.1. If he is feeling so-so today, then he will be C, S, or G tomorrow with probabilities 0.3, 0.4, 0.3. If he is glum today, then he will be C, S, or G tomorrow with probabilities 0.2, 0.3, 0.5. Letting Xn denote Gary’s mood on an nth day, then {Xn, n ≥ 0} n is a three-state Markov chain (state 0 =C, state 1 = S, state 2 = G) with transition probability matrix defined below

0.5 0.4 0.1
0.3 0.4 0.3
0.2 0.3 0.5

Analytical Solution

N/A


Simulation Solution

Comparison of the long run behavior with different initial or starting states. We thus verify (somewhat) that the, in the long run, it doesn’t really matter where the initial state was.

How can Gary be happy? In terms of the Markov chain, it is rather straightforward. Simple increase the probabilities that take him to the state 1 (cheerful). This means that the probability of being cheerful tomorrow is high no matter what today’s state it. Some say this is difficult but there is rather a simple fix to this (Just sleep more 😴). I am taking this as a reference from Matthew Walker’s Why we sleep.? 


Code

Module[{iterations = 100000},
  Table[Module[{matrix = {{0.5, 0.4, 0.1}, {0.3, 0.4, 0.3}, {0.2, 0.3,
    0.5}}, data, \[ScriptCapitalP], happinessAssociation},
    happinessAssociation = <|1 -> "Cheerful", 2 -> "So-So",
      3 -> "Glum"|>;
    \[ScriptCapitalP] = DiscreteMarkovProcess[initial, matrix];
    data =
        KeySort@Counts[
          RandomFunction[\[ScriptCapitalP], {0, iterations}][[2, 1, 1]]];
    BarChart[data, Frame -> True, ImageSize -> 262, AspectRatio -> 1,
      PlotRange -> {Automatic, {0, 0.7 iterations}},
      ChartLabels ->
          Placed[{Values@data,
            Rotate[#, Divide[Pi, 4]] & /@ (happinessAssociation[#] & /@
                Keys@data)}, {Above, Bottom}],
      Epilog ->
          Text[Style[
            "Initial State = " <> ToString[happinessAssociation[initial]],
            12], {2, .6750 iterations}]]
  ], {initial, Range[3]}] //
      Labeled[Grid[Partition[#, 3]],
        Rotate[Style[
          "Number of iterations per Markov Chain: " <>
              ToString@iterations, 14, Red], 0], Top] &]


Module[{iterations = 100000},
  Table[Module[{matrix = {{p, Divide[1 - p, 2], Divide[1 - p, 2]}, {p,
    Divide[1 - p, 2], Divide[1 - p, 2]}, {p, Divide[1 - p, 2],
    Divide[1 - p, 2]}}, data, \[ScriptCapitalP],
    happinessAssociation},
    happinessAssociation = <|1 -> "Cheerful", 2 -> "So-So",
      3 -> "Glum"|>;
    \[ScriptCapitalP] = DiscreteMarkovProcess[1, matrix];
    data =
        KeySort@Counts[
          RandomFunction[\[ScriptCapitalP], {0, iterations}][[2, 1, 1]]];
    Overlay[{BarChart[data, Frame -> True, ImageSize -> 262,
      AspectRatio -> 1, PlotRange -> {Automatic, {0, 1 iterations}},
      ChartLabels ->
          Placed[{ToString[#] <> "\n" & /@ (Values@data),
            Rotate[#, 0] & /@ (happinessAssociation[#] & /@
                Keys@data)}, {Above, Bottom}]], Grid@matrix},
      Alignment -> {0.8, 0.8}]
  ], {p, Range[0.1, 0.9, 0.1]}] //
      Labeled[Grid[Partition[#, 3]],
        Rotate[Style[
          "Number of iterations per Markov Chain: " <>
              ToString@iterations, 14, Red], 0], Top] &]

End of the post


.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.