(* Content-type: application/vnd.wolfram.player *) (*** Wolfram Notebook File ***) (* http://www.wolfram.com/nb *) (* CreatedBy='Mathematica 8.0' *) (*CacheID: 234*) (* Internal cache information: NotebookFileLineBreakTest NotebookFileLineBreakTest NotebookDataPosition[ 152, 7] NotebookDataLength[ 32325, 829] NotebookOptionsPosition[ 30960, 779] NotebookOutlinePosition[ 31470, 800] CellTagsIndexPosition[ 31427, 797] WindowTitle->The Gambler's Ruin - Source WindowFrame->Normal*) (* Beginning of Notebook Content *) Notebook[{ Cell["The Gambler's Ruin", "Section", CellFrame->{{0, 0}, {0, 0}}, ShowCellBracket->False, FontColor->RGBColor[0.597406, 0, 0.0527047]], Cell[CellGroupData[{ Cell[BoxData[ GraphicsBox[RasterBox[CompressedData[" 1:eJztnVuSozgWQDNiPqa3MJ+zpVlCbaB3WlGVNV9dvYH6TQRUph/ZGIHQmwvG xoZzQu3Aku7VfUj4Nk53//fLn//78q+Xl5f/NP/88e+Xl8v154Xj5+fp89y0 4+X63L7VnQu02XqOt9FzjRK5qtRMoYZFpk11/Ji+WDye92+r7+fFfbnGkuu9 eIQ4LBVJ+YRo5DPnRdITDp0TLRg6m/62nY/n08f5+H461G37fWqum57z4Xy2 jby0prMZOh4/jodLOx2bt6fzRSEA3B/KMKGSBy/DSKVcyYOn8krHqajvqed6 G6iol4qkfAIVNQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADsizPA/lj72AEA AMCmWLu0AXh01j6jAAAAcdb+hNwUJ5e1zZnPDEeey/e1jx0AAABsirVLm03x XFVlhs1X1JNY+4wCAAB02B9PJ4BdsvYpBAAAgOeGihpADo9GAUDIr+Lnr7ef a9vw16/i73VtMPx6+2v1gGwMijeAE89FAQA2DRW1BxX14lBRA0wi+lx0baMA AAAAAAAAAAAAbkj0uegR4L4cDoe1TYA1YQMAbIaDy9rm3JU9+w4AjwB3np3D BgDYDHuuKu/su3k0ynNRACGLHMy93dm2ijCPpHvD7LliAQAAmA0VNRioqIGK GlYk9Vz0AAAAAAAAAAAAALBR9KPR8Kf0a9sFAAAAAAAAAAAAcCt4LgoAAAAA AAAAAAB7I/Vc9ONheH9/X9uEzUJsZ0PoAGBZ3gNuLQgggR21GUjl7SC2syF0 ALAsVNQgxMv14XAI/xOja9sIAAAAT0lYWM5jbT/msGffAQAAAGAp9lxV3sF3 b1r0uehSZgAAAAAAAAAAAAA8Ar9b6rpuXpu3+tf0PBcFWJcFvxYBAAAAANgh VNQAADCK5LnobwAAAAAAAAAAAIANUbcPRav+wehH7LmoUqpsqKqmNTSXRVE0 by593mtRXlrfo7mImTlVN6ebUOhR07q3jmxVWXqquqxVOUjZq1eDVNe662ro Nxe1Xr5o2lt5cUc7VWr3BpGindNL6TkDl5nVIGWtbuaXWbwJo/OVKjSX68oL shMTO4ylHf+yy5GbhU5EubJJPeWgx5ayBfvOIR2qD5QJXWmFtJs2pLsLvu40 4oOesh/tJ3TKW/3DomZONgVdVPtNXvVXYWydyBRl/NWNWNW62L06G344TcNW L/SVpaTqcmeOWGWOm3W+TFPWsbL8dE1yklUal73ghDtBH+Hu1dE/HBM7/t7h sjNoN29Calrl2GadWfsMeoc0elcR584clrm5qzO5a+5mQe4imy2Tu1qcu+g2 7od7mkvVtqJtajgInQuqzUrRtWFCzIAkzQdK0/RR1U33JEhtgOhosnmLKtX0 DArVhaJHtZOlmgPbVN+mWZhRGzNvEc13MD61kIRcEPS2WciRp/C97a0ow569 DCOVRurZU0lFnUoBFbWkKiv7I0xFLc4dFXUAFfVUtVTUYRD2V1EnfTd7u920 v+va/NXoSXM86qXVwFtzgNvS7vJG3730Ga76Wkq/6lFz3dlWOa+69XpUOSix ixQtrrVV1pxBleO+uesMsv6QjenXF+bViFjGO5rtObaUp7bVoENe21Kqy1Un 1M8xOaxNftysOh61q5joKStQpbkIQ2p54HRWXcqsOsbVU7oZNBr8Fbv+yotk GBkvbuFbu9/LkY6DF3ZvTvqtOVXdBi0dlN6WZekEsHfQ2flmjpnQ+25vfn// 2yH1eswnokp/tNkpsJNrTqJruX4tzAkKBJXJVdUbbJmtrwtrUfuoGm2Ru5S3 AcrEGQyPld3jzbFTH+oP+is3d+XVuev2wI1zN9w8rZM1I3dFf203xxKvuUyT TevJkd8JSzF7iVHBzJa+D0vFZJLapawNh6xiQ91ixaf03R+lDHvaMqwPCKl8 +lRGgkZF3W3Q0oGKmoq685yKmoo6L5jZ0vdhqZhMUruUteEQFfUk37VU98C8 qRvq+uPjQz8UPZ/P+snoZYIqVAwtaFY0r+E0+8l8VIM3Gs70JkelUoLR0XBm 2X5dldcmWS5lQ2r1jDue+DBaRvrzvidVpc2WOKJicRvVZu+HaFqjgpngC/MS Fek2rRvSjKCy9rnxfepWFFKokVMzWaEsU9GDbEYnbfuoYOpGkdcwql/Sv+fc CVdJcY1a+Yo3WuUaZsfE+9S+j3mTRuFZoAxL9eTtFK6ecccTH0bnlmGkMtXz dKnMLCTpifZTUUfnyNOR4QGrstQuHTXGFqSiXiV3wlVSXKNWvuKNVrmG2TGh ooZb0+T0rUWf/br9e1HvuWjR/z1/+JOUIujKPxYu+l9YCEX0kGVARDxjjHxa ygZv6ejF6KiE0cfp0eUk6JMrmVamQx1qkPTIRzNSo4LC0OnbV7S/tD7WRw32 ElFYP1/y7EkZn09lPhHedej7vDiHSkbzq79YsWcWfUUUzYgXf7mdqa04eiK0 ebYxe86d9yE+T3n+OzuVqHbMx01Up/kkCud7Q0ZJ5uvCRQhNGvVCoueayK9O mKP8qDDd9szol7b5AM5LSup0P7LvxXBX8dWGvlCGTTJm1IBwianK3QySyo2k clR/KtShBkmPfDQjNSpIRS0xexJRy8NjS0UtMfVBcmegoh6FijrkEarKPVfU Gd89w+rwd/Tt34uq/kuT6C2xsG5WhXvLsu+KUb+8/kxsvQMryUIxdp8PLc/c FiblXaJEcgvKuODFf54N8yYXwYejZ2fUbO8i5b7kXwRSPfJtFu1JWZ7BtlZu eRg9XXJEbcuriorIU2xkjYjQi2hJFjXeFvFmhjeNUWu9HhO3/LQoe8tdSKqC ys+f+tE5aZVoBSU0T87U+sr2emq4Ur7k9eQrhydiaqiF3LqSX4QFfacMk684 yaT7l2GkUr7iJJOoqKMrUlGPritxZ9RyT9aIUFHn133e3IVQUQvVUlHPhor6 1r6r/k9G9X1A/47+dDrZ/9+lb9++vbr8+PHDe7X7w077rafHU+JNTo1GF/Wu U52hhtCjqGEZJVGdoZsp5ZmZoRe2kc3Fd0tnKGKvJQ9UKr8pRh15dY0MZTOO e/pTa43OSUmFpn5Pbzzv7agveTNCJRnZ70FCX4OU5ZWn9KfiELrpLZ3aIZn0 RYmGN+NRPsIpd7y19pa7qIhQZ15coicVmamMLjpb1SLmLUgmzlOtzau6RRAm bYxFTJoh9Vy+U4aNKonqDN1MKc/MDL2wjXydWIaRylElz5LKVExSS2Scigqm HHl1jQxlM457+lNrjc5JSYWmUlF7jqQ2RmqHZNIXJRrejEf5CKfc8dbaW+6i IkKdeXGJnlRkpjK66GxVi5i3IJk4T7U2r+oWQZi0MRYxaYbUZnyPLvH/lte2 FP/69esnAAAAAAAAAAAAwM74B4thROM= "], {{0, 0}, {1800, 25}}, {0, 255}, ColorFunction->RGBColor], ImageSize->{1800, 25}, PlotRange->{{0, 1800}, {0, 25}}]], "Section", CellFrame->{{0, 0}, {0, 0}}, ShowCellBracket->False], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"success", "[", RowBox[{"p_", ",", "i_", ",", "c_"}], "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"r", "=", FractionBox[ RowBox[{"1.", "-", "p"}], "p"]}], ",", RowBox[{"T", "=", RowBox[{"i", "+", "c"}]}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{ RowBox[{"p", "\[Equal]", RowBox[{"1", "/", "2"}]}], ",", RowBox[{"N", "[", FractionBox["i", "T"], "]"}], ",", FractionBox[ RowBox[{"1", "-", SuperscriptBox["r", "i"]}], RowBox[{"1", "-", SuperscriptBox["r", "T"]}]]}], "]"}]}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{ RowBox[{"expectedPlaysToRuin", "[", RowBox[{"p_", ",", "i_", ",", "c_"}], "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"r", "=", FractionBox[ RowBox[{"1.", "-", "p"}], "p"]}], ",", RowBox[{"T", "=", RowBox[{"i", "+", "c"}]}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{ RowBox[{"p", "\[Equal]", RowBox[{"1", "/", "2"}]}], ",", RowBox[{"i", "*", "c"}], ",", RowBox[{ FractionBox[ RowBox[{"r", "+", "1"}], RowBox[{"r", "-", "1"}]], RowBox[{"(", RowBox[{"i", "-", RowBox[{"T", "*", FractionBox[ RowBox[{"1", "-", SuperscriptBox["r", "i"]}], RowBox[{"1", "-", SuperscriptBox["r", "T"]}]]}]}], ")"}]}]}], "]"}]}], "]"}]}], ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"gambleToRuinSimulation", "[", RowBox[{"p_", ",", "i_", ",", "c_", ",", "games_"}], "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"playerval", "=", "i"}], ",", RowBox[{"houseval", "=", "c"}], ",", RowBox[{"pts", "=", RowBox[{"{", RowBox[{"{", RowBox[{"0", ",", "i"}], "}"}], "}"}]}], ",", RowBox[{ "message", "=", "\"\\""}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"Do", "[", RowBox[{ RowBox[{ RowBox[{"AppendTo", "[", RowBox[{"pts", ",", RowBox[{"{", RowBox[{"g", ",", "playerval"}], "}"}]}], "]"}], ";", RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{"Random", "[", "]"}], "<", "p"}], ",", RowBox[{ RowBox[{"playerval", "++"}], ";", RowBox[{"houseval", "--"}]}], ",", RowBox[{ RowBox[{"playerval", "--"}], ";", RowBox[{"houseval", "++"}]}]}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{ RowBox[{"playerval", "==", RowBox[{"c", "+", "i"}]}], " ", ",", RowBox[{ RowBox[{"message", "=", RowBox[{"Row", "[", RowBox[{"{", RowBox[{"\"\\"", ",", RowBox[{"Length", "[", "pts", "]"}], ",", "\"\< bets.\>\""}], "}"}], "]"}]}], ";", RowBox[{"Break", "[", "]"}]}]}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{ RowBox[{"playerval", "\[Equal]", "0"}], " ", ",", RowBox[{ RowBox[{"message", "=", RowBox[{"Row", "[", RowBox[{"{", RowBox[{"\"\\"", ",", RowBox[{"Length", "[", "pts", "]"}], ",", "\"\< bets.\>\""}], "}"}], "]"}]}], ";", RowBox[{"Break", "[", "]"}]}]}], "]"}]}], ",", RowBox[{"{", RowBox[{"g", ",", "games"}], "}"}]}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"ListPlot", "[", RowBox[{"pts", ",", RowBox[{"AxesOrigin", "\[Rule]", RowBox[{"{", RowBox[{"0", ",", "0"}], "}"}]}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{ "\"\\"", ",", "\"\\""}], "}"}]}], ",", RowBox[{"PlotLabel", "\[Rule]", RowBox[{"Style", "[", RowBox[{ RowBox[{"Framed", "[", "message", "]"}], ",", "18", ",", RowBox[{"RGBColor", "[", RowBox[{".49", ",", "0", ",", "0"}], "]"}]}], "]"}]}], ",", RowBox[{"Joined", "\[Rule]", "True"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"RGBColor", "[", RowBox[{".49", ",", "0", ",", "0"}], "]"}]}], ",", "\[IndentingNewLine]", RowBox[{"LabelStyle", "\[Rule]", RowBox[{"{", RowBox[{"15", ",", "Bold"}], "}"}]}], ",", "\[IndentingNewLine]", RowBox[{"ImageSize", "\[Rule]", RowBox[{"{", RowBox[{"600", ",", "300"}], "}"}]}], ",", RowBox[{"ImagePadding", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"35", ",", "115"}], "}"}], ",", RowBox[{"{", RowBox[{"20", ",", "30"}], "}"}]}], "}"}]}]}], "]"}]}]}], "]"}]}], ";"}]}], "Input", InitializationCell->True, CellChangeTimes->{ 3.35696210375764*^9, 3.439729188234375*^9, {3.43990183415625*^9, 3.439901834578125*^9}, {3.43990212384375*^9, 3.43990212515625*^9}, { 3.439910603629174*^9, 3.4399106688967*^9}, {3.4399107330661163`*^9, 3.439910840381847*^9}, {3.439941739337255*^9, 3.43994174491538*^9}, { 3.44011440782475*^9, 3.440114419121625*^9}, {3.440176043113903*^9, 3.4401760434179335`*^9}}, CellID->144498769], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Manipulate", "[", RowBox[{ RowBox[{"Column", "[", RowBox[{"{", RowBox[{ RowBox[{"Grid", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"Text", "@", RowBox[{"Style", "[", RowBox[{ RowBox[{"Row", "[", RowBox[{"{", RowBox[{"\"\\"", ",", RowBox[{"Chop", "@", RowBox[{"N", "[", RowBox[{"success", "[", RowBox[{"pp", ",", "ii", ",", "cc"}], "]"}], "]"}]}]}], "}"}], "]"}], ",", "16", ",", "Bold"}], "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{"Text", "@", RowBox[{"Style", "[", RowBox[{ RowBox[{"Row", "[", RowBox[{"{", RowBox[{ "\"\\"", ",", RowBox[{"NumberForm", "[", RowBox[{ RowBox[{"expectedPlaysToRuin", "[", RowBox[{"pp", ",", "ii", ",", "cc"}], "]"}], ",", "8"}], "]"}]}], "}"}], "]"}], ",", "16", ",", "Bold"}], "]"}]}], "}"}]}], "}"}], ",", RowBox[{"Frame", "\[Rule]", "All"}], ",", RowBox[{"ItemSize", "\[Rule]", "43"}]}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"gambleToRuinSimulation", "[", RowBox[{"pp", ",", "ii", ",", "cc", ",", "gg"}], "]"}]}], "}"}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ "gg", ",", "500", ",", "\"\\""}], "}"}], ",", RowBox[{"{", RowBox[{"50", ",", "100", ",", "500", ",", "1000", ",", "5000"}], "}"}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ "pp", ",", "0.50", ",", "\"\\""}], "}"}], ",", "0.40", ",", "0.60", ",", ".001", ",", RowBox[{"Appearance", "\[Rule]", "\"\\""}], ",", RowBox[{"ControlPlacement", "\[Rule]", "Top"}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"ii", ",", "50", ",", "\"\\""}], "}"}], ",", "10", ",", "1000", ",", "5", ",", RowBox[{"Appearance", "\[Rule]", "\"\\""}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"cc", ",", "100", ",", "\"\\""}], "}"}], ",", "50", ",", "10000", ",", "10", ",", RowBox[{"Appearance", "\[Rule]", "\"\\""}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"SaveDefinitions", "\[Rule]", "True"}], ",", "\[IndentingNewLine]", RowBox[{"TrackedSymbols", "\[RuleDelayed]", " ", RowBox[{"{", RowBox[{"gg", ",", "pp", ",", "ii", ",", "cc"}], "}"}]}]}], "]"}]], "Input", CellChangeTimes->{ 3.35696210375764*^9, 3.43968511790625*^9, {3.43968544778125*^9, 3.4396854879375*^9}, {3.439686524484375*^9, 3.439686527859375*^9}, { 3.439686569328125*^9, 3.4396865729375*^9}, {3.439686615640625*^9, 3.4396866166875*^9}, {3.4399019415625*^9, 3.439901941921875*^9}, { 3.439902063125*^9, 3.43990210221875*^9}, {3.4399105760974207`*^9, 3.439910576480459*^9}, {3.439910677636574*^9, 3.4399107136231723`*^9}, { 3.4401093735418997`*^9, 3.4401093773089*^9}, {3.4401094648159*^9, 3.4401094662068996`*^9}, {3.440176007961388*^9, 3.4401760240119925`*^9}}], Cell[BoxData[ TagBox[ StyleBox[ DynamicModuleBox[{$CellContext`cc$$ = 100, $CellContext`gg$$ = 500, $CellContext`ii$$ = 50, $CellContext`pp$$ = 0.5, Typeset`show$$ = True, Typeset`bookmarkList$$ = {}, Typeset`bookmarkMode$$ = "Menu", Typeset`animator$$, Typeset`animvar$$ = 1, Typeset`name$$ = "\"untitled\"", Typeset`specs$$ = {{{ Hold[$CellContext`gg$$], 500, "number of games in simulation"}, {50, 100, 500, 1000, 5000}}, {{ Hold[$CellContext`pp$$], 0.5, "player's fixed win probability"}, 0.4, 0.6, 0.001}, {{ Hold[$CellContext`ii$$], 50, "player's initial stake"}, 10, 1000, 5}, {{ Hold[$CellContext`cc$$], 100, "casino's initial stake"}, 50, 10000, 10}}, Typeset`size$$ = {600., {175.5, 180.5}}, Typeset`update$$ = 0, Typeset`initDone$$, Typeset`skipInitDone$$ = False, $CellContext`gg$683159$$ = 0, $CellContext`pp$683160$$ = 0, $CellContext`ii$683161$$ = 0, $CellContext`cc$683162$$ = 0}, DynamicBox[Manipulate`ManipulateBoxes[ 1, StandardForm, "Variables" :> {$CellContext`cc$$ = 100, $CellContext`gg$$ = 500, $CellContext`ii$$ = 50, $CellContext`pp$$ = 0.5}, "ControllerVariables" :> { Hold[$CellContext`gg$$, $CellContext`gg$683159$$, 0], Hold[$CellContext`pp$$, $CellContext`pp$683160$$, 0], Hold[$CellContext`ii$$, $CellContext`ii$683161$$, 0], Hold[$CellContext`cc$$, $CellContext`cc$683162$$, 0]}, "OtherVariables" :> { Typeset`show$$, Typeset`bookmarkList$$, Typeset`bookmarkMode$$, Typeset`animator$$, Typeset`animvar$$, Typeset`name$$, Typeset`specs$$, Typeset`size$$, Typeset`update$$, Typeset`initDone$$, Typeset`skipInitDone$$}, "Body" :> Column[{ Grid[{{ Text[ Style[ Row[{"Probability of gambler's success: ", Chop[ N[ $CellContext`success[$CellContext`pp$$, $CellContext`ii$$, \ $CellContext`cc$$]]]}], 16, Bold]]}, { Text[ Style[ Row[{"Expected number of plays until ruin or success: ", NumberForm[ $CellContext`expectedPlaysToRuin[$CellContext`pp$$, \ $CellContext`ii$$, $CellContext`cc$$], 8]}], 16, Bold]]}}, Frame -> All, ItemSize -> 43], $CellContext`gambleToRuinSimulation[$CellContext`pp$$, \ $CellContext`ii$$, $CellContext`cc$$, $CellContext`gg$$]}], "Specifications" :> {{{$CellContext`gg$$, 500, "number of games in simulation"}, {50, 100, 500, 1000, 5000}}, {{$CellContext`pp$$, 0.5, "player's fixed win probability"}, 0.4, 0.6, 0.001, Appearance -> "Labeled", ControlPlacement -> Top}, {{$CellContext`ii$$, 50, "player's initial stake"}, 10, 1000, 5, Appearance -> "Labeled"}, {{$CellContext`cc$$, 100, "casino's initial stake"}, 50, 10000, 10, Appearance -> "Labeled"}}, "Options" :> { TrackedSymbols :> {$CellContext`gg$$, $CellContext`pp$$, \ $CellContext`ii$$, $CellContext`cc$$}}, "DefaultOptions" :> {ControllerLinking -> True}], ImageSizeCache->{647., {260., 265.}}, SingleEvaluation->True], Deinitialization:>None, DynamicModuleValues:>{}, Initialization:>(({$CellContext`success[ Pattern[$CellContext`p, Blank[]], Pattern[$CellContext`i, Blank[]], Pattern[$CellContext`c, Blank[]]] := Module[{$CellContext`r = ( 1. - $CellContext`p)/$CellContext`p, $CellContext`T = \ $CellContext`i + $CellContext`c}, If[$CellContext`p == 1/2, N[$CellContext`i/$CellContext`T], ( 1 - $CellContext`r^$CellContext`i)/( 1 - $CellContext`r^$CellContext`T)]], \ $CellContext`expectedPlaysToRuin[ Pattern[$CellContext`p, Blank[]], Pattern[$CellContext`i, Blank[]], Pattern[$CellContext`c, Blank[]]] := Module[{$CellContext`r = ( 1. - $CellContext`p)/$CellContext`p, $CellContext`T = \ $CellContext`i + $CellContext`c}, If[$CellContext`p == 1/2, $CellContext`i $CellContext`c, (($CellContext`r + 1)/($CellContext`r - 1)) ($CellContext`i - $CellContext`T (( 1 - $CellContext`r^$CellContext`i)/( 1 - $CellContext`r^$CellContext`T)))]], \ $CellContext`gambleToRuinSimulation[ Pattern[$CellContext`p, Blank[]], Pattern[$CellContext`i, Blank[]], Pattern[$CellContext`c, Blank[]], Pattern[$CellContext`games, Blank[]]] := Module[{$CellContext`playerval = $CellContext`i, \ $CellContext`houseval = $CellContext`c, $CellContext`pts = {{ 0, $CellContext`i}}, $CellContext`message = "Neither the gambler nor the house was ruined."}, Do[AppendTo[$CellContext`pts, {$CellContext`g, \ $CellContext`playerval}]; If[Random[] < $CellContext`p, Increment[$CellContext`playerval]; Decrement[$CellContext`houseval], Decrement[$CellContext`playerval]; Increment[$CellContext`houseval]]; If[$CellContext`playerval == $CellContext`c + $CellContext`i, \ $CellContext`message = Row[{"The house was ruined after ", Length[$CellContext`pts], " bets."}]; Break[]]; If[$CellContext`playerval == 0, $CellContext`message = Row[{"The gambler was ruined after ", Length[$CellContext`pts], " bets."}]; Break[]], {$CellContext`g, $CellContext`games}]; ListPlot[$CellContext`pts, AxesOrigin -> {0, 0}, AxesLabel -> {"number of bets", "current stake of the gambler"}, PlotLabel -> Style[ Framed[$CellContext`message], 18, RGBColor[0.49, 0, 0]], Joined -> True, PlotStyle -> RGBColor[0.49, 0, 0], LabelStyle -> {15, Bold}, ImageSize -> {600, 300}, ImagePadding -> {{35, 115}, {20, 30}}]]}; Typeset`initDone$$ = True); ReleaseHold[{{ HoldComplete[$CellContext`success[ Pattern[$CellContext`p, Blank[]], Pattern[$CellContext`i, Blank[]], Pattern[$CellContext`c, Blank[]]] := Module[{$CellContext`r = ( 1. - $CellContext`p)/$CellContext`p, $CellContext`T = \ $CellContext`i + $CellContext`c}, If[$CellContext`p == 1/2, N[$CellContext`i/$CellContext`T], ( 1 - $CellContext`r^$CellContext`i)/( 1 - $CellContext`r^$CellContext`T)]]; Null], HoldComplete[Null], HoldComplete[$CellContext`expectedPlaysToRuin[ Pattern[$CellContext`p, Blank[]], Pattern[$CellContext`i, Blank[]], Pattern[$CellContext`c, Blank[]]] := Module[{$CellContext`r = ( 1. - $CellContext`p)/$CellContext`p, $CellContext`T = \ $CellContext`i + $CellContext`c}, If[$CellContext`p == 1/2, $CellContext`i $CellContext`c, (($CellContext`r + 1)/($CellContext`r - 1)) ($CellContext`i - $CellContext`T (( 1 - $CellContext`r^$CellContext`i)/( 1 - $CellContext`r^$CellContext`T)))]]; Null], HoldComplete[Null], HoldComplete[$CellContext`gambleToRuinSimulation[ Pattern[$CellContext`p, Blank[]], Pattern[$CellContext`i, Blank[]], Pattern[$CellContext`c, Blank[]], Pattern[$CellContext`games, Blank[]]] := Module[{$CellContext`playerval = $CellContext`i, \ $CellContext`houseval = $CellContext`c, $CellContext`pts = {{ 0, $CellContext`i}}, $CellContext`message = "Neither the gambler nor the house was ruined."}, Do[AppendTo[$CellContext`pts, {$CellContext`g, \ $CellContext`playerval}]; If[Random[] < $CellContext`p, Increment[$CellContext`playerval]; Decrement[$CellContext`houseval], Decrement[$CellContext`playerval]; Increment[$CellContext`houseval]]; If[$CellContext`playerval == $CellContext`c + $CellContext`i, \ $CellContext`message = Row[{"The house was ruined after ", Length[$CellContext`pts], " bets."}]; Break[]]; If[$CellContext`playerval == 0, $CellContext`message = Row[{"The gambler was ruined after ", Length[$CellContext`pts], " bets."}]; Break[]], {$CellContext`g, $CellContext`games}]; ListPlot[$CellContext`pts, AxesOrigin -> {0, 0}, AxesLabel -> { "number of bets", "current stake of the gambler"}, PlotLabel -> Style[ Framed[$CellContext`message], 18, RGBColor[0.49, 0, 0]], Joined -> True, PlotStyle -> RGBColor[0.49, 0, 0], LabelStyle -> {15, Bold}, ImageSize -> {600, 300}, ImagePadding -> {{35, 115}, {20, 30}}]]; Null]}}]; Typeset`initDone$$ = True), SynchronousInitialization->True, UnsavedVariables:>{Typeset`initDone$$}, UntrackedVariables:>{Typeset`size$$}], "Manipulate", Deployed->True, StripOnInput->False], Manipulate`InterpretManipulate[1]]], "Output", CellID->188483953] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["CAPTION", "Section", CellFrame->{{0, 0}, {1, 0}}, CellFrameColor->RGBColor[0.87, 0.87, 0.87], FontFamily->"Helvetica", FontSize->12, FontWeight->"Bold", FontColor->RGBColor[0.597406, 0, 0.0527047]], Cell[TextData[{ "The gambler starts with an ", Cell[BoxData[ FormBox["i", TraditionalForm]], "InlineMath"], " unit stake and the casino or house starts with ", Cell[BoxData[ FormBox["c", TraditionalForm]], "InlineMath"], " units. They repeatedly play a game for which the gambler has a fixed \ probability ", Cell[BoxData[ FormBox["p", TraditionalForm]], "InlineMath"], " of winning and the winner gets 1 unit from the loser. Play continues until \ the gambler \"succeeds\" by acquiring ", Cell[BoxData[ FormBox[ RowBox[{"i", "+", "c"}], TraditionalForm]], "InlineMath"], " units or is \"ruined\" by dropping to 0 units. This Demonstration computes \ the probability that the gambler will succeed by breaking the bank. \ Subtracting this probability from 1 gives the gambler's ruin probability. The \ theoretical expected number of plays of the game until success or ruin is \ also computed and a simulation gives empirical results for the various \ parameter values. In the example shown in the thumbnail we use ", Cell[BoxData[ FormBox[ RowBox[{"p", "=", "0.474"}], TraditionalForm]], "InlineMath"], ", the player's probability of winning an \"even money\" bet in American \ roulette. " }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["DETAILS", "Section", CellFrame->{{0, 0}, {1, 0}}, CellFrameColor->RGBColor[0.87, 0.87, 0.87], FontFamily->"Helvetica", FontSize->12, FontWeight->"Bold", FontColor->RGBColor[0.597406, 0, 0.0527047]], Cell[TextData[{ "Snapshot 1: a fair game\[LongDash]in such cases the gambler's overall \ success probability is simply ", Cell[BoxData[ FormBox[ FractionBox["i", RowBox[{"i", "+", "c"}]], TraditionalForm]], "InlineMath"], ", the gambler's proportion of the total stake and the expected number of \ plays until ruin is ", Cell[BoxData[ FormBox[ RowBox[{"i", " ", "c"}], TraditionalForm]], "InlineMath"] }], "Text"], Cell[TextData[{ "Snapshot 2: ", Cell[BoxData[ FormBox[ RowBox[{"p", "=", "0.53"}], TraditionalForm]], "InlineMath"], ", which is about what an expert card counter in blackjack might achieve; in \ the simulation, the gambler generates a nice profit, but would require a very \ long time to break the bank" }], "Text"], Cell["\<\ Snapshot 3: results also apply to two individuals playing \"head on\"; here \ the \"player\" triumphs with the help of a larger bankroll, despite the fact \ that the odds slightly favor the opponent\ \>", "Text"], Cell["\<\ Related results: Derivation of the relevant formulas for probability of \ success and for expected time for success or ruin involves a nice application \ of recurrence relations. It also provides an interesting example of an \ absorbing Markov chain. For a more elementary approach, see Chapter 6 of the \ reference below.\ \>", "Text"], Cell[TextData[{ "E. Packel, ", StyleBox["The Mathematics of Games and Gambling", FontSlant->"Italic"], ", 2nd ed., Washington: The Mathematical Association of America, 2006." }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["THIS NOTEBOOK IS THE SOURCE CODE FROM", "Text", CellFrame->{{0, 0}, {0, 0}}, CellMargins->{{48, 10}, {4, 28}}, CellGroupingRules->{"SectionGrouping", 25}, CellFrameMargins->{{48, 48}, {6, 5}}, CellFrameColor->RGBColor[0.87, 0.87, 0.87], FontFamily->"Helvetica", FontSize->10, FontWeight->"Bold", FontColor->RGBColor[0.597406, 0, 0.0527047]], Cell[TextData[{ "\"", ButtonBox["The Gambler's Ruin", BaseStyle->"Hyperlink", ButtonData->{ URL["http://demonstrations.wolfram.com/TheGamblersRuin/"], None}, ButtonNote->"http://demonstrations.wolfram.com/TheGamblersRuin/"], "\"", " from ", ButtonBox["the Wolfram Demonstrations Project", BaseStyle->"Hyperlink", ButtonData->{ URL["http://demonstrations.wolfram.com/"], None}, ButtonNote->"http://demonstrations.wolfram.com/"], "\[ParagraphSeparator]\[NonBreakingSpace]", ButtonBox["http://demonstrations.wolfram.com/TheGamblersRuin/", BaseStyle->"Hyperlink", ButtonData->{ URL["http://demonstrations.wolfram.com/TheGamblersRuin/"], None}, ButtonNote->"http://demonstrations.wolfram.com/TheGamblersRuin/"] }], "Text", CellMargins->{{48, Inherited}, {0, Inherited}}, FontFamily->"Verdana", FontSize->10, FontColor->GrayLevel[0.5]], Cell[TextData[{ "Contributed by: ", ButtonBox["Ed Packel", BaseStyle->"Hyperlink", ButtonData->{ URL["http://demonstrations.wolfram.com/author.html?author=Ed+Packel"], None}, ButtonNote-> "http://demonstrations.wolfram.com/author.html?author=Ed+Packel"], " (Lake Forest College)" }], "Text", CellDingbat->"\[FilledSmallSquare]", CellMargins->{{66, 48}, {2, 4}}, FontFamily->"Verdana", FontSize->10, FontColor->GrayLevel[0.6]], Cell[TextData[{ "A full-function Wolfram ", StyleBox["Mathematica", FontSlant->"Italic"], " system (Version 6 or higher) is required to edit this notebook.\n", StyleBox[ButtonBox["GET WOLFRAM MATHEMATICA \[RightGuillemet]", BaseStyle->"Hyperlink", ButtonData->{ URL["http://www.wolfram.com/products/mathematica/"], None}, ButtonNote->"http://www.wolfram.com/products/mathematica/"], FontFamily->"Helvetica", FontWeight->"Bold", FontSlant->"Italic", FontColor->RGBColor[1, 0.42, 0]] }], "Text", CellFrame->True, CellMargins->{{48, 68}, {8, 28}}, CellFrameMargins->12, CellFrameColor->RGBColor[0.87, 0.87, 0.87], CellChangeTimes->{3.3750111182355957`*^9}, ParagraphSpacing->{1., 1.}, FontFamily->"Verdana", FontSize->10, FontColor->GrayLevel[0.411765], Background->RGBColor[1, 1, 1]], Cell[TextData[{ "\[Copyright] ", StyleBox[ButtonBox["Wolfram Demonstrations Project & Contributors", BaseStyle->"Hyperlink", ButtonData->{ URL["http://demonstrations.wolfram.com/"], None}, ButtonNote->"http://demonstrations.wolfram.com/"], FontColor->GrayLevel[0.6]], "\[ThickSpace]\[ThickSpace]\[ThickSpace]|\[ThickSpace]\[ThickSpace]\ \[ThickSpace]", StyleBox[ButtonBox["Terms of Use", BaseStyle->"Hyperlink", ButtonData->{ URL["http://demonstrations.wolfram.com/termsofuse.html"], None}, ButtonNote->"http://demonstrations.wolfram.com/termsofuse.html"], FontColor->GrayLevel[0.6]], "\[ThickSpace]\[ThickSpace]\[ThickSpace]|\[ThickSpace]\[ThickSpace]\ \[ThickSpace]", StyleBox[ButtonBox["Make a new version of this Demonstration \ \[RightGuillemet]", BaseStyle->"Hyperlink", ButtonData->{ URL["http://demonstrations.wolfram.com/participate/upload.jsp?id=\ TheGamblersRuin"], None}, ButtonNote->None], FontColor->GrayLevel[0.6]] }], "Text", CellFrame->{{0, 0}, {0, 0.5}}, CellMargins->{{48, 10}, {20, 50}}, CellFrameMargins->{{6, 0}, {6, 6}}, CellFrameColor->GrayLevel[0.6], FontFamily->"Verdana", FontSize->9, FontColor->GrayLevel[0.6]] }, Open ]] }, Editable->True, Saveable->False, ScreenStyleEnvironment->"Working", CellInsertionPointCell->None, WindowSize->{984, 494}, WindowMargins->{{Inherited, Inherited}, {Inherited, 0}}, WindowTitle->"The Gambler's Ruin - Source", DockedCells->{}, FrontEndVersion->"8.0 for Microsoft Windows (32-bit) (February 23, 2011)", StyleDefinitions->"Default.nb" ] (* End of Notebook Content *) (* Internal cache information *) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[593, 21, 138, 3, 66, "Section"], Cell[CellGroupData[{ Cell[756, 28, 3700, 64, 37, "Section"], Cell[4459, 94, 5989, 164, 374, "Input", InitializationCell->True, CellID->144498769], Cell[CellGroupData[{ Cell[10473, 262, 3682, 88, 252, "Input"], Cell[14158, 352, 9795, 209, 542, "Output", CellID->188483953] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[24002, 567, 209, 6, 62, "Section"], Cell[24214, 575, 1227, 27, 70, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[25478, 607, 209, 6, 32, "Section"], Cell[25690, 615, 432, 12, 70, "Text"], Cell[26125, 629, 324, 8, 70, "Text"], Cell[26452, 639, 222, 4, 70, "Text"], Cell[26677, 645, 346, 6, 70, "Text"], Cell[27026, 653, 191, 5, 70, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[27254, 663, 355, 9, 20, "Text", CellGroupingRules->{"SectionGrouping", 25}], Cell[27612, 674, 870, 24, 34, "Text"], Cell[28485, 700, 451, 15, 18, "Text"], Cell[28939, 717, 815, 24, 98, "Text"], Cell[29757, 743, 1187, 33, 88, "Text"] }, Open ]] } ] *) (* End of internal cache information *)