(* Content-type: application/mathematica *)

(*** Wolfram Notebook File ***)
(* http://www.wolfram.com/nb *)

(* CreatedBy='Mathematica 6.0' *)

(*CacheID: 234*)
(* Internal cache information:
NotebookFileLineBreakTest
NotebookFileLineBreakTest
NotebookDataPosition[       145,          7]
NotebookDataLength[      7833,        248]
NotebookOptionsPosition[      6665,        207]
NotebookOutlinePosition[      7003,        222]
CellTagsIndexPosition[      6960,        219]
WindowFrame->Normal
ContainsDynamic->False*)

(* Beginning of Notebook Content *)
Notebook[{
Cell["MATH 540:  Markov Chain Boundary Problem", "Text",
 TextAlignment->Center,
 FontSize->18,
 FontWeight->"Bold"],

Cell["NAME:", "Text",
 FontWeight->"Bold"],

Cell[TextData[{
 "Instructions:  (a)  Type your name above. \n (b)  For each exercise:  (i)  \
Copy and paste the program provided within the ",
 StyleBox["Markov Chain Solution to Boundary Problem",
  FontWeight->"Bold"],
 " section below.  \n (ii)  Make the necessary edits to the initial \
parameters and then enter all the commands.  Remember to scale down the \
values as appropriate.  But then re-scale the ",
 StyleBox["AvgHeight",
  FontWeight->"Bold"],
 " code near the end by multiplying by the scale factor.\n (iii)  Write \
sentences that summarize the answers to the questions.  "
}], "Text"],

Cell[CellGroupData[{

Cell["Markov Chain Solution to Boundary Problem", "Section",
 TextAlignment->Left,
 FontSize->14,
 FontWeight->"Bold"],

Cell["\<\
Enter Initial Paramters:  (Any lower bound can be used, not just 0.  \
Therefore, you do not need to translate vertically.)\
\>", "Text"],

Cell["\<\
InitialAmount=J=6;
SizeOfUpwardJumps=a=3;
SizeOfDownwardJumps=b=2;
ProbUp=p=.4;
ProbDown=q=.5;
ProbConstant=r=1-q-p;
UpperBound=n=10;
LowerBound=m=0;\
\>", "Input",
 AspectRatioFixed->True],

Cell["Create Initial State Vector:", "Text"],

Cell["B=Table[If[j==J,1,0],{i,1,1},{j,m+1-b,n-1+a}]", "Input",
 AspectRatioFixed->True],

Cell["Create Height Vector:", "Text"],

Cell[BoxData[
 RowBox[{"H", "=", 
  RowBox[{"Table", "[", 
   RowBox[{"j", ",", 
    RowBox[{"{", 
     RowBox[{"i", ",", "1", ",", "1"}], "}"}], ",", 
    RowBox[{"{", 
     RowBox[{"j", ",", 
      RowBox[{"m", "+", "1", "-", "b"}], ",", 
      RowBox[{"n", "-", "1", "+", "a"}]}], "}"}]}], "]"}]}]], "Input"],

Cell["Create Matrix of Transition Probabilities:", "Text"],

Cell["\<\
Do[t[i,j]=0,{i,m+1-b,n-1+a},{j,m+1-b,n-1+a}];
Do[t[i,i]=1,{i,m+1-b,m}];
Do[t[i,i-b]=q,{i,m+1,n-1}];
Do[t[i,i]=r,{i,m+1,n-1}];
Do[t[i,i+a]=p,{i,m+1,n-1}];
Do[t[i,i]=1,{i,n,n-1+a}];
A=Table[t[i,j],{i,m+1-b,n-1+a},{j,m+1-b,n-1+a}];
MatrixForm[A]\
\>", "Input",
 AspectRatioFixed->True],

Cell["Create Probability State After k Bets:", "Text"],

Cell["\<\
NumberOfBets=k=5;
Z=B.MatrixPower[A,k];
MatrixForm[Reverse[Table[{i-b,N[Z[[1]][[i-m]]]},{i,m+1,n-1+a+b}]]]\
\>", "Input",
 CellChangeTimes->{3.416067205515424*^9},
 AspectRatioFixed->True],

Cell[BoxData[
 RowBox[{"AvgHeight", "=", 
  RowBox[{"N", "[", 
   RowBox[{"Z", ".", 
    RowBox[{"Transpose", "[", "H", "]"}]}], "]"}]}]], "Input"],

Cell["ProbReachTopOrAbove=N[Sum[Z[[1]][[i]],{i,n-m+b,n-1+a-m+b}]]", "Input",
 AspectRatioFixed->True],

Cell["ProbReachBottomOrBelow=N[Sum[Z[[1]][[i]],{i,1,b}]]", "Input",
 AspectRatioFixed->True],

Cell[BoxData[
 RowBox[{"ProbBelowInitialHeight", "=", 
  RowBox[{"N", "[", 
   RowBox[{"Sum", "[", 
    RowBox[{
     RowBox[{
      RowBox[{"Z", "[", 
       RowBox[{"[", "1", "]"}], "]"}], "[", 
      RowBox[{"[", "i", "]"}], "]"}], ",", 
     RowBox[{"{", 
      RowBox[{"i", ",", "1", ",", 
       RowBox[{"J", "-", "m", "+", "b", "-", "1"}]}], "}"}]}], "]"}], 
   "]"}]}]], "Input"],

Cell[BoxData[
 RowBox[{"ProbInitialHeightOrAbove", "=", 
  RowBox[{"N", "[", 
   RowBox[{"1", "-", 
    RowBox[{"Sum", "[", 
     RowBox[{
      RowBox[{
       RowBox[{"Z", "[", 
        RowBox[{"[", "1", "]"}], "]"}], "[", 
       RowBox[{"[", "i", "]"}], "]"}], ",", 
      RowBox[{"{", 
       RowBox[{"i", ",", "1", ",", 
        RowBox[{"J", "-", "m", "+", "b", "-", "1"}]}], "}"}]}], "]"}]}], 
   "]"}]}]], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell["Exercise 1", "Section"],

Cell[TextData[{
 "When betting on \[OpenCurlyDoubleQuote]Red\[CloseCurlyDoubleQuote] in \
roulette, the probability of winning is p = 18/38. Suppose you start with \
$5000 and bet $100 at a time.  The payoff is also $100. Your goal is to reach \
$6000.  You will quit if you reach $6000 or drop to $2000.\n\n(a)  (i)  After \
a maximum of 10 bets, what are your 4 most likely remaining dollar values and \
what are the probabilities of having these dollar amounts?\n(ii)  What is the \
average fortune after these 10 possible bets?\n(iii)  What is the probability \
of having at least as much money as you started with after at most 10 bets?\n\
\nFor Part (b), type in ",
 StyleBox["Mathematica",
  FontSlant->"Italic"],
 " code for the actual closed-form symmetric random walk formulas and then \
enter those lines, rather than running the program with a large number of \
steps.  \n\n(b)  (i)  What is the long-term probability of reaching $6000 \
before dropping to $2000?  \n(ii)  What is the average fortune when quitting \
upon reaching $6000 or dropping to $2000?\n(iii)  What is the average number \
of bets that would be made when stopping upon reaching one of these \
boundaries?"
}], "Text"]
}, Closed]],

Cell[CellGroupData[{

Cell["Exercise 2", "Section"],

Cell["\<\
When betting on a \[OpenCurlyDoubleQuote]column\[CloseCurlyDoubleQuote] in \
roulette, the probability of winning is p = 12/38.  Suppose you start with \
$200 and bet $5 at a time.  The payoff is  $10. Your goal is to reach $225.  \
You will quit if you reach $225 (or higher) or drop to $50.

(a)  (i)  After a maximum of 5 bets, what is the probability of having hit \
your goal of $225 or higher?
(ii)  What is the average fortune after these 5 possible bets?
(iii)  What is the probability that you are still playing after 5 bets?

For Part (b), simply copy and paste the codes below \
\[OpenCurlyDoubleQuote]Create Probability State After k Bets:\
\[CloseCurlyDoubleQuote]  Then enter the codes with k being \[GreaterEqual] \
2000 to approximate the end state.  (Of course, I assume that codes for Part \
(a) have just been entered so that the parameters are initialized.)

(b)  (i)  What is the long-term probability of reaching $225 or higher before \
dropping to $50?  
(ii)  What is the average fortune when quitting upon reaching $225 (or \
higher) or dropping to $50?
(iii)  Given that you do in fact reach $225 or higher, what proportion of the \
time is it actually $225?\
\>", "Text"]
}, Closed]]
},
WindowSize->{750, 425},
WindowMargins->{{Automatic, 106}, {Automatic, 17}},
FrontEndVersion->"6.0 for Mac OS X x86 (32-bit) (April 20, 2007)",
StyleDefinitions->"Default.nb"
]
(* End of Notebook Content *)

(* Internal cache information *)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[568, 21, 116, 3, 32, "Text"],
Cell[687, 26, 42, 1, 26, "Text"],
Cell[732, 29, 605, 12, 101, "Text"],
Cell[CellGroupData[{
Cell[1362, 45, 118, 3, 61, "Section"],
Cell[1483, 50, 147, 3, 26, "Text"],
Cell[1633, 55, 199, 10, 118, "Input"],
Cell[1835, 67, 44, 0, 26, "Text"],
Cell[1882, 69, 87, 1, 27, "Input"],
Cell[1972, 72, 37, 0, 26, "Text"],
Cell[2012, 74, 311, 9, 27, "Input"],
Cell[2326, 85, 58, 0, 26, "Text"],
Cell[2387, 87, 292, 10, 118, "Input"],
Cell[2682, 99, 54, 0, 26, "Text"],
Cell[2739, 101, 198, 6, 53, "Input"],
Cell[2940, 109, 147, 4, 27, "Input"],
Cell[3090, 115, 101, 1, 27, "Input"],
Cell[3194, 118, 92, 1, 27, "Input"],
Cell[3289, 121, 387, 12, 27, "Input"],
Cell[3679, 135, 422, 13, 27, "Input"]
}, Open  ]],
Cell[CellGroupData[{
Cell[4138, 153, 29, 0, 67, "Section"],
Cell[4170, 155, 1202, 19, 394, "Text"]
}, Closed]],
Cell[CellGroupData[{
Cell[5409, 179, 29, 0, 37, "Section"],
Cell[5441, 181, 1208, 23, 394, "Text"]
}, Closed]]
}
]
*)

(* End of internal cache information *)