(*********************************************************************** Mathematica-Compatible Notebook This notebook can be used on any computer system with Mathematica 3.0, MathReader 3.0, or any compatible application. The data for the notebook starts with the line of stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. ***********************************************************************) (*CacheID: 232*) (*NotebookFileLineBreakTest NotebookFileLineBreakTest*) (*NotebookOptionsPosition[ 63842, 2134]*) (*NotebookOutlinePosition[ 64694, 2164]*) (* CellTagsIndexPosition[ 64650, 2160]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{ Cell[TextData[ "Generalized Boundary Problem for One-Dimensional Random Walks"], "Title", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[StyleBox[ "by\nDavid K. Neal\nDepartment of Mathematics\nWestern Kentucky University\n\ Bowling Green, KY 42101\nnealdk@wkuvx1.wku.edu\n", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Times"]], "Subtitle", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Palatino"], Cell[TextData[ "Mathematica in Education\nVol. 3 No.4\nCopyright 1994\n\ TELOS/Springer-Verlag"], "Subsubtitle", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{ Cell[TextData[StyleBox["Abstract", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Palatino"]], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "The boundary problem for non-symmetric one-dimensional random walks\nis \ described and simulated graphically. We estimate the probability of a \n\ particle reaching the top boundary before the lower boundary and estimate \n\ the average time to reach either boundary. Confidence intervals for these\n\ estimates are also given. A matrix solution to these problems is then given\n\ followed by an application to the Gambler's Ruin problem."], "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData["Introduction"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "A famous problem in probability theory is the \.bcDrunkard's Walk\.bd which \ can \nbe described as follows. Suppose a particle begins at height m > 0 on \ the y-axis.\nOn each unit time interval, the particle moves up 1 step with \ probability p or\ndown 1 step with probability q = 1-p. (i) What is the \ probability that the particle \nreaches either height n > m or height 0? \ (ii) What is the probability P[m] that \nthe particle reaches height n before \ height 0? (iii) What is the average number \nof steps T[m] needed to reach \ one of these two boundaries?"], "Text", Evaluatable->False, PageBreakBelow->True, AspectRatioFixed->True], Cell[TextData[StyleBox[ "Each problem can be solved by one standard technique involving difference \n\ equations [Chu75, p. 243; Fel57, p. 313]. Most importantly, these solutions \ yield\nclosed-form formulas. Namely, (i) the particle will reach a boundary \ with \nprobability 1; (ii) for p = .5, P[m] = m/n, and for p \:203a .5, P[m] \ = (1-(q/p)m)/(1-(q/p)n),\nand (iii) for p = .5, T[m] = m(n-m), and for p \ \:203a .5, T[m] = \nn/(p-q)*(1-(q/p)m)/(1-(q/p)n) - m/(p-q). These formulas \ can easily be \ngeneralized for any lower boundary less than m. ", Evaluatable->False, PageBreakBelow->True, AspectRatioFixed->True, FontFamily->"Times"]], "Text", Evaluatable->False, PageBreakBelow->True, AspectRatioFixed->True, FontFamily->"Palatino"], Cell[TextData[StyleBox[ "We can generalize the problem further by assuming that the particle moves \n\ up height h with probability p or down height k with probability q = 1-p, \ where \nh and k are any positive real numbers. Unfortunately, the above \ difference \nequation technique will no longer work. This problem has been \ considered in\nconnection with sequential sampling when h and k are integers \ [Fel57, p. 330];\nhowever, there is not a known closed-form solution. In \ this article, we shall \ndescribe a probabilistic method of approximating the \ solutions for given values\nof p, m, n, h, and k. Then we shall give an \ algebraic method for finding the\nexact solution for any given set of initial \ values provided h and k are integers.\nThe techniques will be implemented \ with brief Mathematica programs.", Evaluatable->False, PageBreakBelow->True, AspectRatioFixed->True, FontFamily->"Times"]], "Text", Evaluatable->False, PageBreakBelow->True, AspectRatioFixed->True, FontFamily->"Palatino"], Cell[TextData[StyleBox[ "The material in this article is one of a dozen or so projects that the \ author\nuses as supplemental material for a beginning calculus-based course \ in\nprobability and statistics. For all such projects, students are to read \ the problem\nand solution and then run the program. Students then work a few \ exercises\nwhich involve slight modifications of the program. These students \ generally\nhave had no prior experience with Mathematica or Macintosh \ machines. By \nthe end of the semester however, they seem to have a good \ working knowledge\nof both. Moreover, they gain a much greater understanding \ of probabilistic\nconcepts and have fun doing it.", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Times"]], "Text", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Palatino"] }, Closed]], Cell[CellGroupData[{ Cell[TextData["Probability Estimation Technique "], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "To approximate the probability of reaching n first, we can apply the Law\nof \ Large Numbers to a sample of random walks and merely count the \nproportion \ of particles which reach or exceed the top boundary first. We can\nalso \ average the number of steps needed to reach or exceed a boundary for this\n\ sample in order to approximate the true average time. We can then establish \ \nbounds for our approximations by constructing confidence intervals. \n\ Mathematica can easily generate random walks which fit the parameters of the \ \nproblem and can also display graphs which illustrate the problem."], "Text",\ Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "We shall demonstrate with the following values : p = .40, h = 3.2, k = 2.4, \ \nm = 6, and n = 10. We first enter all the variables:"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "p = .40;\nq = 1-p;\nStepsUp = h = 3.2;\nStepsDown = k = 2.4;\nStartingHeight \ = m = 6;\nUpperBoundary = n = 10; "], "Input", AspectRatioFixed->True], Cell[TextData[ "We shall make our estimations based on, say 300, trials. Therefore, \nwe \ must construct a loop of 300 random walks which begin at starting height \nm \ and go up h steps with probability p or down k steps with probability q. \ Each \nwalk stops when reaching the upper boundary of 10 or the lower \ boundary of 0. \n(If desired, one can always change the lower boundary to \ any value below m.)\nThe height of the ith particle on its jth step is \ denoted by x[i,j], for i = 1,...,300.\nFor the program, we first set the \ number of trials and set all the initial heights \nequal to m. Within the \ loop, t[i] counts the number of steps that the ith walk \nneeded to reach a \ boundary and u[i] determines whether or not the walk ended \nat or above \ height n. "], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["trials = 300;\nDo[x[i,0] = m, \n {i, 1, trials}];"], "Input", AspectRatioFixed->True], Cell[TextData[ "Do[j=0;\n While[0 < x[i,j] < n,\n x[i,j+1] = If[Random[] < p, \n \ x[i,j] + h, \n x[i,j] - k];\n \ j++];\n t[i] = j;\n u[i] = If[x[i,t[i]] >= n,\n 1, 0],\n{i, 1, \ trials}]"], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "In order to see graphs of the generated random walks, where the x-axis \n\ denotes time and the y-axis denotes height, we can use the command below. \n\ Here we display only the the first 2 graphs; but the index limits can be \ changed, \nfor instance to ", Evaluatable->False, AspectRatioFixed->True], StyleBox["{i,10,20}", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[", to display any consecutive sequence of graphs.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{ Cell[TextData[ "Do[ListPlot[Table[{j, x[i,j]},\n {j, 0, t[i]}],\n \ PlotJoined -> True,\n AxesOrigin -> Automatic],\n {i, 1, 2}]"], "Input", AspectRatioFixed->True], Cell[CellGroupData[{ Cell[GraphicsData["PostScript", "\<\ %! %%Creator: Mathematica %%AspectRatio: .61803 MathPictureStart %% Graphics /Helvetica findfont 6 scalefont setfont % Scaling calculations 0.02381 0.190476 0.051503 0.091969 [ [(1)] .21429 .0515 0 2 Msboxa [(2)] .40476 .0515 0 2 Msboxa [(3)] .59524 .0515 0 2 Msboxa [(4)] .78571 .0515 0 2 Msboxa [(5)] .97619 .0515 0 2 Msboxa [(1)] .01131 .14347 1 0 Msboxa [(2)] .01131 .23544 1 0 Msboxa [(3)] .01131 .32741 1 0 Msboxa [(4)] .01131 .41938 1 0 Msboxa [(5)] .01131 .51135 1 0 Msboxa [(6)] .01131 .60332 1 0 Msboxa [ -0.001 -0.001 0 0 ] [ 1.001 .61903 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p p .002 w .21429 .0515 m .21429 .05775 L s P [(1)] .21429 .0515 0 2 Mshowa p .002 w .40476 .0515 m .40476 .05775 L s P [(2)] .40476 .0515 0 2 Mshowa p .002 w .59524 .0515 m .59524 .05775 L s P [(3)] .59524 .0515 0 2 Mshowa p .002 w .78571 .0515 m .78571 .05775 L s P [(4)] .78571 .0515 0 2 Mshowa p .002 w .97619 .0515 m .97619 .05775 L s P [(5)] .97619 .0515 0 2 Mshowa p .001 w .0619 .0515 m .0619 .05525 L s P p .001 w .1 .0515 m .1 .05525 L s P p .001 w .1381 .0515 m .1381 .05525 L s P p .001 w .17619 .0515 m .17619 .05525 L s P p .001 w .25238 .0515 m .25238 .05525 L s P p .001 w .29048 .0515 m .29048 .05525 L s P p .001 w .32857 .0515 m .32857 .05525 L s P p .001 w .36667 .0515 m .36667 .05525 L s P p .001 w .44286 .0515 m .44286 .05525 L s P p .001 w .48095 .0515 m .48095 .05525 L s P p .001 w .51905 .0515 m .51905 .05525 L s P p .001 w .55714 .0515 m .55714 .05525 L s P p .001 w .63333 .0515 m .63333 .05525 L s P p .001 w .67143 .0515 m .67143 .05525 L s P p .001 w .70952 .0515 m .70952 .05525 L s P p .001 w .74762 .0515 m .74762 .05525 L s P p .001 w .82381 .0515 m .82381 .05525 L s P p .001 w .8619 .0515 m .8619 .05525 L s P p .001 w .9 .0515 m .9 .05525 L s P p .001 w .9381 .0515 m .9381 .05525 L s P p .002 w 0 .0515 m 1 .0515 L s P p .002 w .02381 .14347 m .03006 .14347 L s P [(1)] .01131 .14347 1 0 Mshowa p .002 w .02381 .23544 m .03006 .23544 L s P [(2)] .01131 .23544 1 0 Mshowa p .002 w .02381 .32741 m .03006 .32741 L s P [(3)] .01131 .32741 1 0 Mshowa p .002 w .02381 .41938 m .03006 .41938 L s P [(4)] .01131 .41938 1 0 Mshowa p .002 w .02381 .51135 m .03006 .51135 L s P [(5)] .01131 .51135 1 0 Mshowa p .002 w .02381 .60332 m .03006 .60332 L s P [(6)] .01131 .60332 1 0 Mshowa p .001 w .02381 .0699 m .02756 .0699 L s P p .001 w .02381 .08829 m .02756 .08829 L s P p .001 w .02381 .10668 m .02756 .10668 L s P p .001 w .02381 .12508 m .02756 .12508 L s P p .001 w .02381 .16187 m .02756 .16187 L s P p .001 w .02381 .18026 m .02756 .18026 L s P p .001 w .02381 .19865 m .02756 .19865 L s P p .001 w .02381 .21705 m .02756 .21705 L s P p .001 w .02381 .25384 m .02756 .25384 L s P p .001 w .02381 .27223 m .02756 .27223 L s P p .001 w .02381 .29062 m .02756 .29062 L s P p .001 w .02381 .30902 m .02756 .30902 L s P p .001 w .02381 .3458 m .02756 .3458 L s P p .001 w .02381 .3642 m .02756 .3642 L s P p .001 w .02381 .38259 m .02756 .38259 L s P p .001 w .02381 .40099 m .02756 .40099 L s P p .001 w .02381 .43777 m .02756 .43777 L s P p .001 w .02381 .45617 m .02756 .45617 L s P p .001 w .02381 .47456 m .02756 .47456 L s P p .001 w .02381 .49296 m .02756 .49296 L s P p .001 w .02381 .52974 m .02756 .52974 L s P p .001 w .02381 .54814 m .02756 .54814 L s P p .001 w .02381 .56653 m .02756 .56653 L s P p .001 w .02381 .58493 m .02756 .58493 L s P p .001 w .02381 .03311 m .02756 .03311 L s P p .001 w .02381 .01472 m .02756 .01472 L s P p .002 w .02381 0 m .02381 .61803 L s P P 0 0 m 1 0 L 1 .61803 L 0 .61803 L closepath clip newpath .004 w .02381 .60332 m .21429 .38259 L .40476 .16187 L .59524 .45617 L .78571 .23544 L .97619 .01472 L s % End of Graphics MathPictureEnd\ \>"], "Graphics", Evaluatable->False, AspectRatioFixed->True, ImageSize->{281, 173}, ImageMargins->{{34, Inherited}, {Inherited, Inherited}}, ImageCache->GraphicsData["Bitmap", "\<\ CF5dJ6E]HGAYHf4PAg9QL6QYHggYjN[Vi^OShn03ooeGooj[ooonICXf=SLcII03=Voc=Vc3=V VC=VIS=Vl000?o00007@0000L000?o0000kP000ol0 000N00001`000ol0003]0003o`0001l0000700;ok@000ol0000P00001`000ol0003[0003o`000240 00070003o`000>/000?o00008@0000L000?o0000jP000ol0000R00001`000ol0003Y0003o`0002<0 00020003o`00008000?o0000j0000ol0000T00000P000ol0000200?oi`000ol0000U00000P000ol0 00020003o`000>H000?o00009P00008000?o00000P000ol0003U0003o`0002L000020003o`000080 00?o0000i@000ol0000W00001`000ol0003T0003o`0002P0000700;oJ0000ol0001i0003o`0002T0 00070003o`0006L000?o0000N0000ol0000Z00001`000ol0001V0003o`3o07P000?o0000:`0000L0 00?o0000I@001Ol0003o07H000?o0000;00000L000?o0000I0000ol000020003o`0007<000?o0000 ;@0000L00_mT0003o`0000@000?o0000L@000ol0000^00001`000ol0001R0003o`0000H000?o0000 L0000ol0000^00001`000ol0001Q0003o`0000L000?o0000K`000ol0000_00001`000ol0001P0003 o`0000T000?o0000K@000ol0000`00001`000ol0001P0003o`0000X000?o0000J`000ol0000a0000 1`02of0000?o00002`000ol0001Z0003o`00038000070003o`0005h000?o00003@000ol0001X0003 o`0003<000070003o`0005d000?o00003`000ol0001V0003o`0003@000070003o`0005`000?o0000 40000ol0001V0003o`0003@000070003o`0005/000?o00004P000ol0001T0003o`0003D0000700;o F`000ol0000C0003o`0006<000?o0000=P0000L000?o0000FP000ol0000D0003o`00064000?o0000 =`0000L000?o0000F@000ol0000F0003o`0005l000?o0000>00000L000?o0000F0000ol0000G0003 o`0005h000?o0000>@0000040?ooo`<000?o0000E`000ol0000I0003o`0005`000?o0000>P000003 0?l000@00omF0003o`0001/000?o0000FP000ol0000k00001`000ol0001E0003o`0001`000?o0000 FP000ol0000k000000@0o`3o0`000ol0001D0003o`0001h000?o0000F0000ol0000l00000P000ol0 00020003o`0005<000?o000080000ol0001F0003o`0003d000070003o`0005<000?o000080000ol0 001E0003o`0003h0000700;oD`000ol0000R0003o`0005<000?o0000?`0000L000?o0000D@000ol0 000T0003o`00054000?o0000@00000L000?o0000D0000ol0000U0003o`00050000?o0000@@0000L0 00?o0000C`000ol0000W0003o`0004h000?o0000@P0000L000?o0000CP000ol0000Y0003o`0004d0 00?o0000@P0000L00_m>0003o`0002X000?o0000C0000ol0001300001`000ol0001<0003o`0002`0 00?o0000BP000ol0001400001`000ol0001<0003o`0002d000?o0000B0000ol0001500001`000ol0 001;0003o`0002h000?o0000A`000ol0001600001`000ol0001:0003o`00030000?o0000A@000ol0 001700001`02odX000?o00000000ol0001A0003o`0002@000?o0000FP0000L000?o0000=P000ol0001C0003o`000280 00?o0000F`0000L000?o0000=@000ol0001E0003o`00020000?o0000G00000L000?o0000=0000ol0 001F0003o`00020000?o0000G00000L000?o0000<`000ol0001H0003o`0001h000?o0000G@0000L0 0_lc0003o`0005X000?o000070000ol0001N00001`000ol0000b0003o`0005X000?o00006`000ol0 001O00001`000ol0000a0003o`0005`000?o00006@000ol0001P00001`000ol0000`0003o`0005h0 00?o00005`000ol0001Q00001`000ol0000_0003o`0005l000?o00005P000ol0001R00001`02obl0 00?o0000H@000ol0000D0003o`0006<000070003o`0002d000?o0000H`000ol0000C0003o`0006<0 00070003o`0002`000?o0000I0000ol0000B0003o`0006@000070003o`0002/000?o0000IP000ol0 000@0003o`0006D000020003o`00008000?o0000:`000ol0001V0003o`0000l000?o0000IP000004 0?ooo`<00olZ0003o`0006P000?o00003@000ol0001W000000<0ool010000ol0000Y0003o`0006X0 00?o00002`000ol0001X00000P000ol000020003o`0002P000?o0000J`000ol0000:0003o`0006T0 00020003o`00008000?o00009`000ol0001]0003o`0000T000?o0000J@0000L000?o00009P000ol0 001_0003o`0000L000?o0000JP0000L00_lV0003o`00070000?o00001P000ol0001[00001`000ol0 000U0003o`00074000?o000010000ol0001/00001`000ol0000T0003o`0007<000?o00000P000ol0 001]00001`000ol0000S0003o`0007@000Go0000o`1`00001`000ol0000R0003o`0007H000?o0?l0 L@0000L00_lR0003o`0007P000?o0000L00000L000?o000080000ol0003/00001`000ol0000O0003 o`000>d000070003o`0001h000?o0000kP0000L000?o00007P000ol0003^00001`02oah000?o0000 k`0000L000?o000070000ol0003`00001`000ol0000K0003o`000?4000070003o`0001X000?o0000 lP0000L000?o00006@000ol0003c00001`000ol0000H0003o`000?@0000700;o60000ol0003e0000 1`000ol0000G0003o`000?D000070003o`0001H000?o0000mP0000L000?o00005@000ol0003g0000 0P000ol000020003o`0001@000?o0000n00000<000Co00000olC0003o`000?T000000`3oo`040003 o`00018000?o0000nP0000030?l000@000?o00004@000ol0003k000000@0oooo0`000ol0000A0003 o`000?/000070003o`00010000?o0000o00000L00_l@0003o`000?d000070003o`0000h000?o0000 oP0000L000?o00003@000ol0003o00001`000ol0000<0003o`000?l00@0000L000?o00002`000ol0 003o0080000700;o2`000ol0003o00<000070003o`0000X000?o0000o`0300001`000ol000090003 o`000?l0100000L000?o000020000ol0003o00D000070003o`0000L000?o0000o`0600001`02o`L0 00?o0000o`0700001`000ol000050003o`000?l0200000L000?o000010000ol0003o00T000070003 o`0000@000?o0000o`0900001`000ol000030003o`000?l02P0000L00_l30003o`000?l02`0000L0 00Go0000o`3o00h000070004o`00ool03`0000L000?o0?l0o`0@00000P000ol0000200;oo`0A0000 00@0o`3o0`03ool0400000030?oo00@000?o0000o`0@000000<0o`0010000ol0003o010000020003 o`00008000?o0000o`0@00001`000ol0003o01000000\ \>"], ImageRangeCache->{{{0, 280}, {172, 0}} -> {-0.149576, -0.570911, 0.0189255, 0.0391965}}], Cell[GraphicsData["PostScript", "\<\ %! %%Creator: Mathematica %%AspectRatio: .61803 MathPictureStart %% Graphics /Helvetica findfont 6 scalefont setfont % Scaling calculations 0.02381 0.095238 -0.00981 0.061313 [ [(2)] .21429 .11282 0 2 Msboxa [(4)] .40476 .11282 0 2 Msboxa [(6)] .59524 .11282 0 2 Msboxa [(8)] .78571 .11282 0 2 Msboxa [(10)] .97619 .11282 0 2 Msboxa [(4)] .01131 .23544 1 0 Msboxa [(6)] .01131 .35807 1 0 Msboxa [(8)] .01131 .48069 1 0 Msboxa [(10)] .01131 .60332 1 0 Msboxa [ -0.001 -0.001 0 0 ] [ 1.001 .61903 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p p .002 w .21429 .11282 m .21429 .11907 L s P [(2)] .21429 .11282 0 2 Mshowa p .002 w .40476 .11282 m .40476 .11907 L s P [(4)] .40476 .11282 0 2 Mshowa p .002 w .59524 .11282 m .59524 .11907 L s P [(6)] .59524 .11282 0 2 Mshowa p .002 w .78571 .11282 m .78571 .11907 L s P [(8)] .78571 .11282 0 2 Mshowa p .002 w .97619 .11282 m .97619 .11907 L s P [(10)] .97619 .11282 0 2 Mshowa p .001 w .0619 .11282 m .0619 .11657 L s P p .001 w .1 .11282 m .1 .11657 L s P p .001 w .1381 .11282 m .1381 .11657 L s P p .001 w .17619 .11282 m .17619 .11657 L s P p .001 w .25238 .11282 m .25238 .11657 L s P p .001 w .29048 .11282 m .29048 .11657 L s P p .001 w .32857 .11282 m .32857 .11657 L s P p .001 w .36667 .11282 m .36667 .11657 L s P p .001 w .44286 .11282 m .44286 .11657 L s P p .001 w .48095 .11282 m .48095 .11657 L s P p .001 w .51905 .11282 m .51905 .11657 L s P p .001 w .55714 .11282 m .55714 .11657 L s P p .001 w .63333 .11282 m .63333 .11657 L s P p .001 w .67143 .11282 m .67143 .11657 L s P p .001 w .70952 .11282 m .70952 .11657 L s P p .001 w .74762 .11282 m .74762 .11657 L s P p .001 w .82381 .11282 m .82381 .11657 L s P p .001 w .8619 .11282 m .8619 .11657 L s P p .001 w .9 .11282 m .9 .11657 L s P p .001 w .9381 .11282 m .9381 .11657 L s P p .002 w 0 .11282 m 1 .11282 L s P p .002 w .02381 .23544 m .03006 .23544 L s P [(4)] .01131 .23544 1 0 Mshowa p .002 w .02381 .35807 m .03006 .35807 L s P [(6)] .01131 .35807 1 0 Mshowa p .002 w .02381 .48069 m .03006 .48069 L s P [(8)] .01131 .48069 1 0 Mshowa p .002 w .02381 .60332 m .03006 .60332 L s P [(10)] .01131 .60332 1 0 Mshowa p .001 w .02381 .13734 m .02756 .13734 L s P p .001 w .02381 .16187 m .02756 .16187 L s P p .001 w .02381 .18639 m .02756 .18639 L s P p .001 w .02381 .21092 m .02756 .21092 L s P p .001 w .02381 .25997 m .02756 .25997 L s P p .001 w .02381 .28449 m .02756 .28449 L s P p .001 w .02381 .30902 m .02756 .30902 L s P p .001 w .02381 .33354 m .02756 .33354 L s P p .001 w .02381 .38259 m .02756 .38259 L s P p .001 w .02381 .40712 m .02756 .40712 L s P p .001 w .02381 .43164 m .02756 .43164 L s P p .001 w .02381 .45617 m .02756 .45617 L s P p .001 w .02381 .50522 m .02756 .50522 L s P p .001 w .02381 .52974 m .02756 .52974 L s P p .001 w .02381 .55427 m .02756 .55427 L s P p .001 w .02381 .57879 m .02756 .57879 L s P p .001 w .02381 .08829 m .02756 .08829 L s P p .001 w .02381 .06377 m .02756 .06377 L s P p .001 w .02381 .03924 m .02756 .03924 L s P p .001 w .02381 .01472 m .02756 .01472 L s P p .002 w .02381 0 m .02381 .61803 L s P P 0 0 m 1 0 L 1 .61803 L 0 .61803 L closepath clip newpath .004 w .02381 .35807 m .11905 .21092 L .21429 .06377 L .30952 .25997 L .40476 .11282 L .5 .30902 L .59524 .16187 L .69048 .01472 L .78571 .21092 L .88095 .40712 L .97619 .60332 L s % End of Graphics MathPictureEnd\ \>"], "Graphics", Evaluatable->False, AspectRatioFixed->True, ImageSize->{281, 173}, ImageMargins->{{34, Inherited}, {Inherited, Inherited}}, ImageCache->GraphicsData["Bitmap", "\<\ CF5dJ6E]HGAYHf4PAg9QL6QYHggYjN[Vi^OShn03ooeGooj[ooonICXf=SLcII03=Voc=Vc3=V VC=VIS=V00002P000ol0 002]0003o`0000/000?o0000CP0000X00_lb0003o`0007P000?o00003@000ol0001=00002P000ol0 000a0003o`0007L000?o00003P000ol0001=00002P000ol0000`0003o`3o07P000?o00003P000ol0 001=00002P000ol0000_0004o`00ogL000?o000040000ol0001<00002P000ol0000_0005o`000?l0 M@000ol0000A0003o`0004`0000:0003o`0002h000?o00000P000ol0001c0003o`00018000?o0000 B`0000X000?o0000;@000ol00003o`030?l002l000?o00000003o`0002T000Co003o>P000ol0000N0003o`0004H0000:0003o`0002H0 00?o000040000ol0000X0005o`000?l0>0000ol0000P0003o`0004D0000:0003o`0002H000?o0000 40000ol0000W0003o`00008000?o0000=@000ol0000Q0003o`0004D0000:0003o`0002D000?o0000 4P000ol0000U0003o`0000@000?o0000=0000ol0000R0003o`0004@0000:00;o9@000ol0000C0003 o`0002D000?o000010000ol0000c0003o`0002<000?o0000A00000X000?o000090000ol0000D0003 o`0002<000?o00001P000ol0000a0003o`0002D000?o0000@`0000X000?o00008`000ol0000E0003 o`00028000?o00001`000ol0000a0003o`0002D000?o0000@`0000X000?o00008P000ol0000G0003 o`00024000?o000020000ol0000_0003o`0002L000?o0000@P0000X000?o00008P000ol0000G0003 o`00020000?o00002@000ol0000^0003o`0002P000?o0000@P0000X000?o00008@000ol0000I0003 o`0001h000?o00002`000ol0000]0003o`0002T000?o0000@@0000X000?o000080000ol0000J0003 o`0001h000?o00002`000ol0000/0003o`0002X000?o0000@@0000X00_lQ0003o`0001/000?o0000 70000ol0000=0003o`0002X000?o0000;0000ol0001000002P000ol0000O0003o`0001`000?o0000 6`000ol0000>0003o`0002X000?o0000;0000ol0001000002P000ol0000N0003o`0001h000?o0000 6P000ol0000>0003o`0002T000?o0000;@000ol0001000002P000ol0000N0003o`0001h000?o0000 6@000ol0000@0003o`0002L000?o0000;`000ol0000o00002P000ol0000M0003o`00020000?o0000 5`000ol0000A0003o`0002L000?o0000;`000ol0000o00002P000ol0000M0003o`00020000?o0000 5`000ol0000B0003o`0002D000?o0000<@000ol0000n00002P000ol0000L0003o`00028000?o0000 5@000ol0000C0003o`0002@000?o00000003 o`0001X000?o00007P000ol0000h0003o`0003/0000:00;o60000ol0000Z0003o`0000h000?o0000 6`000ol0000L0003o`0003X000?o0000>P0000X000?o00005`000ol0000[0003o`0000`000?o0000 70000ol0000K0003o`0003/000?o0000>P0000X000?o00005P000ol0000/0003o`0000/000?o0000 7P000ol0000J0003o`0003`000?o0000>@0000X000?o00005@000ol0000]0003o`0000/000?o0000 7P000ol0000I0003o`0003d000?o0000>@0000X000?o00005@000ol0000^0003o`0000T000?o0000 80000ol0000G0003o`0003l000?o0000>00000X000?o000050000ol0000_0003o`0000P000?o0000 8@000ol0000G0003o`0003l000?o0000>00000@000?o00000`000ol0000D0003o`00030000?o0000 1`000ol0000R0003o`0001D000?o0000@@000ol0000g00000`03o`@00_lD0003o`00034000?o0000 1P000ol0000S0003o`0001@000?o0000@P000ol0000g00000`02o`D000?o00004P000ol0000c0003 o`0000@000?o00009@000ol0000C0003o`0004<000?o0000=P0000@000?o00000`000ol0000B0003 o`0003<000?o000010000ol0000U0003o`00018000?o0000A0000ol0000f000010000ol000030003 o`00014000?o0000=@000ol000020003o`0002L000?o000040000ol000150003o`0003H0000:0003 o`00010000?o0000=P001Ol0003o02X000?o000040000ol000160003o`0003D0000:0003o`000100 00?o0000=`001?l00?l[0003o`0000h000?o0000A`000ol0000e00002P000ol0000?0003o`0003P0 00?o0?l0;0000ol0000=0003o`0004T000?o0000=00000X00_l?0003o`0003X000?o0000;0000ol0 000<0003o`0004T000?o0000=00000X000?o00003P000ol0001Y0003o`0000/000?o0000B`000ol0 000c00002P000ol0000=0003o`0006X000?o00002P000ol0001<0003o`0003<0000:0003o`0000d0 00?o0000J`000ol000090003o`0004d000?o000040 00?o0000:00000@000?o00000`02on<000?o00009`0000<000?o0?l01002on<000?o00009`0000<0 0_l50003o`000><000?o00009P0000<000?o000010000ol0003S0003o`0002H000040003o`0000<0 00?o0000i0000ol0000U00002P000ol0003T0003o`0002D0000:0003o`000>D000?o0000900000X0 00?o0000i@000ol0000T00002P02onH000?o0000900000X000?o0000iP000ol0000S00002P000ol0 003V0003o`0002<0000:0003o`000>L000?o00008P0000X000?o0000i`000ol0000R00002P000ol0 003X0003o`000240000:0003o`000>P000?o00008@0000X00_oZ0003o`000200000:0003o`000>T0 00?o0000800000X000?o0000jP000ol0000O00002P000ol0003Z0003o`0001l0000:0003o`000>/0 00?o00007P0000X000?o0000j`000ol0000N00002P02ond000?o00007@0000X000?o0000k0000ol0 000M00002P000ol0003]0003o`0001`0000:0003o`000>d000?o0000700000X000?o0000kP000ol0 000K00002P000ol0003^0003o`0001/0000:0003o`000>l000?o00006P0000X00_o`0003o`0001X0 000:0003o`000?0000?o00006@0000X000?o0000l0000ol0000I00002P000ol0003a0003o`0001P0 000:0003o`000?4000?o0000600000X000?o0000lP000ol0000G000010000ol000030003o`000?80 00?o00005`0000<000?o0?l01002oo@000?o00005P0000@000?o00000`000ol0003c0003o`0001H0 00030003o`3o00@000?o0000m0000ol0000E000010000ol000030003o`000?@000?o00005@0000X0 00?o0000m@000ol0000D00002P000ol0003e0003o`0001@0000:0003o`000?H000?o00004`0000X0 0_og0003o`0001<0000:0003o`000?L000?o00004P0000X000?o0000m`000ol0000B00002P000ol0 003h0003o`000140000:0003o`000?P000?o00004@0000X000?o0000n@000ol0000@00002P02ooX0 00?o0000400000X000?o0000nP000ol0000?00002P000ol0003j0003o`0000l0000:0003o`000?/0 00?o00003P0000X000?o0000n`000ol0000>00002P000ol0003l0003o`0000d0000:0003o`000?`0 00?o00003@0000X00_on0003o`0000`0000:0003o`000?d000?o0000300000X000?o0000oP000ol0 000;00002P000ol0003n0003o`0000/0000:0003o`000?l000?o00002P0000X000?o0000o`000ol0 000:00002P000ol0003o004000?o00002@0000X00_oo008000?o00002@0000X000?o0000o`020003 o`0000P0000:0003o`000?l00P000ol0000800002P000ol0003o00<000?o00001`0000X000?o0000 o`030003o`0000L0000:0003o`000?l010000ol00006000000D0o`00o`050003o`000?l010000ol0 0006000000H0o`3o0?l400;oo`060003o`0000D000001P3o0?l0o`@000?o0000o`0=000000H0o`3o 0?l40003o`000?l03@0000050?l00?l01@000ol0003o00d0000:0003o`000?l03@000001\ \>"], ImageRangeCache->{{{0, 280}, {172, 0}} -> {-0.38314, 0.121982, 0.0380132, 0.0590462}}] }, Closed]] }, Closed]], Cell[TextData[ "Lastly, we count the proportion to reach the top boundary first and the \n\ average time to reach a boundary for this sample: \ "], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{ Cell[TextData[ "p1 = ProportiontoHitUpper =\n N[Sum[u[i], {i,1,trials}] / trials]"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ 0.4833333333333333\ \>", "\<\ 0.483333\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData[ "SampleMeanTime =\n N[Sum[t[i], {i,1,trials}] / trials]"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ 4.766666666666667\ \>", "\<\ 4.76667\ \>"], "Output", Evaluatable->False, PageBreakWithin->Automatic, AspectRatioFixed->True] }, Closed]], Cell[TextData[ "When using h = k = 1, we can observe the accuracy of the approximations\n by \ adding codes which compute the known real values :"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{ Cell[TextData["RealProb=If[p==.5,m/n,(1-(q/p)^m)/(1-(q/p)^n)]"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ 0.1833692373976734\ \>", "\<\ 0.183369\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData[ "AveTime=If[p==.5,m(n-m),\nn/(p-q)*(1-(q/p)^m)/(1-(q/p)^n) - m/(p-q)]"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ 20.83153813011633\ \>", "\<\ 20.8315\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[TextData["Confidence Intervals "], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "We can now use the data from this sample of random walks to create a\n\ confidence interval for the probability P[m] of reaching n first when \ starting\nat height m. The confidence interval for P[m] is centered around \ the sample \nproportion p1. Since this measurement is a proportion, the true \ variance is \nknown to be P[m](1-P[m]) [HoTa93, p.151], which has a maximum \ value of \n.25 since 0 \[Dagger] P[m] \[Dagger] 1. By taking the square \ root, we obtain a maximum standard \ndeviationof .50. The variance of the \ sample proportion however equals the \ntrue variance divided by sample size \ [HoTa93, p. 267]; hence, the confidence \ninterval is centered at p1 with \ standard deviation .5/Sqrt[trials]. "], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "Using the Statistics`ConfidenceIntervals` package, we now compute a 95%\n\ confidence interval for P[m] : "], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["<True], Cell[TextData["c=.95;"], "Input", AspectRatioFixed->True], Cell[CellGroupData[{ Cell[TextData[ "ProbCI = \n N[NormalCI[p1,.5/Sqrt[trials],\n \ ConfidenceLevel->c]]"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ {0.4267540466295248, 0.5399126200371419}\ \>", "\<\ {0.426754, 0.539913}\ \>"], "Output", Evaluatable->False, GroupPageBreakWithin->Automatic, AspectRatioFixed->True] }, Closed]], Cell[TextData[ "\nSimilarly, we can construct a confidence interval, centered around the \n\ sample mean xbar, for the average time \.a6 to reach a boundary. Though we \n\ would now use the unbiased sample deviation sd as an estimate for the \n\ unknown standard deviation s of the time to reach a boundary. However, \n\ there are some other factors to consider before we do so. "], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "Unlike with the sample proportion, we do not have an upper bound for\nthe \ variance of the time it takes to reach a boundary, nor do we know if this\n\ variance is even finite. If the variance is finite, then we may apply the \ Central\nLimit Theorem to construct a confidence interval based on a normal \ distribution \nabout the sample mean. However, we must be sure that the \ sample size trials \nis large enough so that sd is a good estimate of s and \ so that the the standard \nnormal distribution is a good approximation of the \ distribution of \n(xbar - \.a6 ) / (sd/Sqrt[trials]) ."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "To test these assumptions, it is a better practice to run our simulations in\ \nbatches, say 30 batches of 100 trials each. We then consider the 30 batch \ means\nas a new random sample. If these 30 measurements seem normally \n\ distributed, then it is good evidence that the confidence interval \ constructed \nwill be valid. The commands below create and display such \ batch means."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "Do[Do[j=0;While[0True], Cell[CellGroupData[{ Cell[TextData["TimeData=Table[b[s],{s,1,30}]"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ {4.85, 4.660000000000001, 4.67, 4.96, 4.79, 5.410000000000001, 4.990000000000001, 4.76, 4.360000000000001, 5.070000000000001, 4.85, 5.200000000000001, 5.43, 5.21, 4.780000000000001, 4.530000000000001, 5.05, 4.8, 4.990000000000001, 5.02, 5.51, 4.280000000000001, 4.690000000000001, 5.06, 4.76, 4.900000000000001, 5.08, 5.1, 4.43, 4.700000000000001}\ \>", "\<\ {4.85, 4.66, 4.67, 4.96, 4.79, 5.41, 4.99, 4.76, 4.36, 5.07, 4.85, 5.2, 5.43, 5.21, 4.78, 4.53, 5.05, 4.8, 4.99, 5.02, 5.51, 4.28, 4.69, 5.06, 4.76, 4.9, 5.08, 5.1, 4.43, 4.7}\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[TextData[ "One can observe that these sample means do seem to be consistent with \na \ rather small variance. As an exercise, one can perform a goodness of fit \ test\nfor normality. Finally, we construct a 95% confidence interval using \ the\nsample mean and sample deviation of the above batch means :"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "mu=N[Mean[TimeData]];\nsd=N[StandardDeviation[TimeData]];"], "Input", AspectRatioFixed->True], Cell[CellGroupData[{ Cell[TextData[ "TimeCI=N[NormalCI[mu,sd/Sqrt[30],\n ConfidenceLevel->c]]"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ {4.789362890917982, 5.003303775748682}\ \>", "\<\ {4.78936, 5.0033}\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[TextData["Matrix Solution "], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "We now consider the special case when the upward and downward steps h \nand \ k are integers. We shall describe an algebraic solution for the probability \ \nP[m] of reaching height n before height 0 when starting at height m, for \n\ 0 \[LessEqual] m \[LessEqual] n. We first note that P[n] = 1, since if we \ start at n, then we reach n\nbefore 0 with probability 1. Thus, we also \ define P[k] = 1 for k > n. Moreover, \nP[0] = 0, since we cannot reach n \ before 0 if we start at 0, and we also define \nP[k] = 0 for k < 0. So, we \ must solve for P[1] through P[n-1]. We shall do so by \nsolving n-1 \ equations having these n-1 unknowns. To avoid consideration of \nnumerous \ cases, we assume that k+h < n-1. Simple modifications can be made\nif k+h \ \[GreaterEqual] n - 1. "], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "When starting at height m, for 1 \[LessEqual] m \[LessEqual] n-1, after one \ step we are at height \nm-k with probability q or at height m+h with \ probability p. Then we must \nreach n before 0 when starting at m-k or when \ starting at m+h. Hence,"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ " P[m] = q P[m-k] + p P[m+h]."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ " \nIn particular, the first k equations are"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ " P[1] = q P[1-k] + p P[1+h] = p P[1+h]\n \ \n P[2] = q P[2-k] + p \ P[2+h] = p P[2+h]\n \n \ . . . . . . . . . . . . . . .\n \ \n . . . \ . . . . . . . . . . . . \n \n \ P[k] = q P[k-k] + p P[n-1] = p P[k+h] ."], "Text",\ Evaluatable->False, AspectRatioFixed->True], Cell[TextData["Since k+h < n-1, the next n-1-h-k equations are"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ " P[k+1] = q P[1] + p P[k+1+h] \n \ \n . . . . . . . . . . . \ . .\n \n . . . . \ . . . . . . . . .\n \n \ P[n-1-h] = q P[n-1-h-k] + p P[n-1],"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["and the last h equations are"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ " P[n-h] = q P[n-h-k] + p P[n] = q P[n-h-k] + p\n \ \n . . . . . . . . . . . . . . \ .\n \n . . . . . . \ . . . . . . . . .\n \n P[n-1] = q P[n-1-k] + \ p P[n-1+h] = q P[n-1-k] + p"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["The first k equations can be written as follows:"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ " P[1] - p P[1+h] = 0\n \ \n P[2] - p P[2+h] = 0\n \ \n . . . .\n \ \n P[k] - p P[k+h] \ = 0"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["The next n-1-h-k equations can be written as follows:"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ " -q P[1] + P[k+1] - p P[k+1+h] = 0\n \ \n . . \ . . . . . . . .\n \n -q \ P[n-1-h-k] + P[n-1-h] - p P[n-1] = 0 ."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ " \nFinally, the last h equations can be written as"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ " - q P[n-h-k] + P[n-h] = p\n \ \n . \ . . . . .\n \n - q \ P[n-1-k] + P[n-1] = p ."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ " \nHence, we obtain the following (n-1)x n augmented matrix \ which represents \nthe n-1 equations, having P[1] through P[n-1] as the n-1 \ unknowns, where the \n-p is h columns to the right of the 1 in each of the \ first n-1-h rows, the -q is k\ncolumns to the left of the 1 in the last n-1-k \ rows, and p occurs in the right-\nmost column in the last h rows. "], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[StyleBox[ " 1 0 0 0 . -p 0 . . . . 0 0 0 | 0\n 0 1 0 0 . 0 \ -p 0 . . . 0 0 0 | 0\n 0 0 1 0 . 0 0 -p 0 . . 0 0 0 \ | 0\n 0 0 0 1 . 0 0 0 -p 0 . 0 0 0 | 0\n . . . . \ . . . . . . . . . . | 0\n -q 0 0 . . 1 0 0 0 . -p . \ 0 0 | 0\n 0 -q 0 0 . . 1 0 0 0 . -p 0 0 | 0\n 0 . -q \ 0 0 . . 1 0 0 0 . -p 0 | 0\n . . . . . . . . . . . \ . . . | 0\n 0 . . -q 0 0 . . 1 . . . 0 | p\n 0 . \ . . -q 0 0 . . 1 . . 0 | p\n 0 . . . . . -q 0 0 . \ 1 . 0 | p\n 0 . . . . . . -q 0 0 . . 1 . | p\n 0 \ . . . . . . -q 0 0 . . 1 | p\n \n ", AspectRatioFixed->True, FontWeight->"Plain"]], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "If we let A denote the (n-1)x(n-1) matrix of coefficients on the left side \ of \nthe augmented matrix, and let B denote the right-most column, then the \ \nsystem can be represented by the equation AX = B, where X denotes the \n\ column of unknowns P[1],. . ., P[n-1]. The solution for X is then given by \ \nX = A", Evaluatable->False, AspectRatioFixed->True], StyleBox["-1 ", Evaluatable->False, AspectRatioFixed->True, FontVariations->{"CompatibilityType"->"Superscript"}], StyleBox["B. ", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "Of course it is not practical to solve the system of equations by hand; \ thus, \nwe can solve the system numerically for specific p and q or \ theoretically for \narbitrary p and q by using a short program."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "Again, we first enter the necessary parameters and we note that this \n\ technique will provide a solution for all starting heights m; so, we can \ clear \nthis variable. Moreover, we have changed the values of h and k to \ integers."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "Clear[m,a,b];\np = .40;\nq = 1-p;\nStepsUp = h = 3;\nStepsDown = k = 2;\n\ UpperBoundary = n = 10; "], "Input", AspectRatioFixed->True], Cell[TextData[ "The following commands create the (n-1)x(n-1) matrix of coefficients A:"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "a=IdentityMatrix[n-1];\nDo[a[[i,i-k]]=-q,{i,k+1,n-1}];\n\ Do[a[[i,i+h]]=-p,{i,1,n-1-h}];"], "Input", AspectRatioFixed->True], Cell[CellGroupData[{ Cell[TextData["a"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ {{1, 0, 0, -0.4, 0, 0, 0, 0, 0}, {0, 1, 0, 0, -0.4, 0, 0, 0, 0}, {-0.6, 0, 1, 0, 0, -0.4, 0, 0, 0}, {0, -0.6, 0, 1, 0, 0, -0.4, 0, 0}, {0, 0, -0.6, 0, 1, 0, 0, -0.4, 0}, {0, 0, 0, -0.6, 0, 1, 0, 0, -0.4}, {0, 0, 0, 0, -0.6, 0, 1, 0, 0}, {0, 0, 0, 0, 0, -0.6, 0, 1, 0}, {0, 0, 0, 0, 0, 0, -0.6, 0, 1}}\ \>", "\<\ {{1, 0, 0, -0.4, 0, 0, 0, 0, 0}, {0, 1, 0, 0, -0.4, 0, 0, 0, 0}, {-0.6, 0, 1, 0, 0, -0.4, 0, 0, 0}, {0, -0.6, 0, 1, 0, 0, -0.4, 0, 0}, {0, 0, -0.6, 0, 1, 0, 0, -0.4, 0}, {0, 0, 0, -0.6, 0, 1, 0, 0, -0.4}, {0, 0, 0, 0, -0.6, 0, 1, 0, 0}, {0, 0, 0, 0, 0, -0.6, 0, 1, 0}, {0, 0, 0, 0, 0, 0, -0.6, 0, 1}}\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[TextData["The next command creates the (n-1)x 1 matrix B :"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{ Cell[TextData["b=Table[If[i<=n-h-1,0,p],{i,1,n-1},{j,1,1}] "], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ {{0}, {0}, {0}, {0}, {0}, {0}, {0.4}, {0.4}, {0.4}}\ \>", "\<\ {{0}, {0}, {0}, {0}, {0}, {0}, {0.4}, {0.4}, {0.4}}\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[TextData[{ StyleBox["Lastly, we solve the system AX = B for X using the ", Evaluatable->False, AspectRatioFixed->True], StyleBox["LinearSolve", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[" command.\nWe then display a table of values {m,P[m]}, for 1 ", Evaluatable->False, AspectRatioFixed->True], "\[LessEqual]", StyleBox[" m ", Evaluatable->False, AspectRatioFixed->True], "\[LessEqual]", StyleBox[ " n-1, which gives the\nprobabilities of reaching n first when starting at \ height m. We have displayed \nthe output for the last command which occurs \ using our initial values.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["Soln = LinearSolve[a, b];"], "Input", AspectRatioFixed->True], Cell[CellGroupData[{ Cell[TextData["Table[{m, Soln[[m]]}, {m,1,n-1}]"], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ {{1, {0.1574099955771782}}, {2, {0.1946041574524546}}, {3, {0.3193149933657673}}, {4, {0.3935249889429455}}, {5, {0.4865103936311366}}, {6, {0.5621724900486509}}, {7, {0.6919062361786819}}, {8, {0.7373034940291907}}, {9, {0.815143741707209}}}\ \>", "\<\ {{1, {0.15741}}, {2, {0.194604}}, {3, {0.319315}}, {4, {0.393525}}, {5, {0.48651}}, {6, {0.562172}}, {7, {0.691906}}, {8, {0.737303}}, {9, {0.815144}}}\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[TextData["Other Matrix Solutions "], "Section", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Palatino"], Cell[TextData[ "We now let R[m] be the probability of reaching (or exceeding) a boundary of \ 0\nor n when starting at height m. With only one modification, we can use \ the \nsame matrix technique as above to verify that R[m] = 1 for all m. We \ note that\nR[0] = R[n] = 1, since if we start at 0 or n then we reach 0 or n. \ Likewise R[k] = 1 \nfor k < 0 and k > n. The only modification then is \ that the first k equations can \nbe written with the right hand side equaling \ q rather than 0. We need only \ncreate a new right-most column for the \ augmented matrix and then solve for \nR[1],. . .,R[m] :"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{ Cell[TextData[ "b2 = Table[If[i<=k,q,If[i<=n-h-1,0,p]],\n {i,1,n-1}, {j,1,1}]"], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ {{0.6}, {0.6}, {0}, {0}, {0}, {0}, {0.4}, {0.4}, {0.4}}\ \>", "\<\ {{0.6}, {0.6}, {0}, {0}, {0}, {0}, {0.4}, {0.4}, {0.4}}\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData["Soln2 = LinearSolve[a, b2]"], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ {{1.}, {1.}, {1.}, {1.}, {1.}, {1.}, {1.}, {1.}, {1.}}\ \>", "\<\ {{1.}, {1.}, {1.}, {1.}, {1.}, {1.}, {1.}, {1.}, {1.}}\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[TextData[ "With another modification, we can find the average number of steps needed \n\ to reach a boundary. If we let T[m] denote the average number when starting \ \nat height m, then T[0] = T[n] = 0 since it does not require a step to reach \ the\nboundary if we start at a boundary. Likewise, T[k] = 0 for k < 0 and k \ > n. For\n0 < m < n however, we take 1 step and then we proceed from height \ m-k with \nprobability q or from height m+h with probability p. Thus,\nT[m] \ = 1 + q T[m-k] + p T[m+h]. Since, T[k] = 0 for k \[LessEqual] 0 and k \ \[GreaterEqual] n, we will obtain \nthe same system of equations as before; \ but now, each entry in the right-most\ncolumn will be 1. Again we need only \ create a new column and then solve\nfor each T[m]. "], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{ Cell[TextData["b3=Table[1,{i,1,n-1},{j,1,1}]"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ {{1}, {1}, {1}, {1}, {1}, {1}, {1}, {1}, {1}}\ \>", "\<\ {{1}, {1}, {1}, {1}, {1}, {1}, {1}, {1}, {1}}\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[TextData["Soln3 = LinearSolve[a, b3];"], "Input", AspectRatioFixed->True], Cell[CellGroupData[{ Cell[TextData["Table[{m,Soln3[[m]]},\n {m, 1, n-1}]"], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ {{1, {2.864449358690844}}, {2, {3.217602830605927}}, {3, {4.812674038036267}}, {4, {4.661123396727112}}, {5, {5.544007076514817}}, {6, {5.235011057054401}}, {7, {4.326404245908889}}, {8, {4.14100663423264}}, {9, {3.595842547545333}}}\ \>", "\<\ {{1, {2.86445}}, {2, {3.2176}}, {3, {4.81267}}, {4, {4.66112}}, {5, {5.54401}}, {6, {5.23501}}, {7, {4.3264}}, {8, {4.14101}}, {9, {3.59584}}}\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[TextData[ "For h = k = 1, we could also verify the matrix solutions for P[m] and \n\ T[m] by adding commands which list the previously known formulas:"], "Text", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Palatino"], Cell[TextData[ "Table[{m,If[p==.5,m/n,(1-(q/p)^m)/(1-(q/p)^n)]},\n{m,1,n-1}]"], "Input", AspectRatioFixed->True], Cell[TextData[ "Table[{m,If[p==.5,m(n-m),\nn/(p-q)*(1-(q/p)^m)/(1-(q/p)^n) - \ m/(p-q)]},{m,1,n-1}]"], "Input", AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData["Application To Gambling "], "Section", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Palatino"], Cell[TextData[{ "A famous application of the ``Drunkard's Walk'' is the ``Gambler's Ruin'' \ \nproblem. We first find the probability Q[m] = 1 - P[m] of reaching 0 \ before \nreaching n. This setting can now be interpreted as the probability \ of ``going \nbroke'' before reaching a goal of $n if starting with $m when \ one either wins \n$h with probability p or loses $k with probability q on \ each bet. For h = k = 1, \nwe of course have a closed-form expression: For p \ = .5, Q[m] = (n-m)/n and for\np \[NotEqual] .5, Q[m] = ((q/p)^m - (q/p)^n)/(1 \ - (q/p)^n). Then for p \[LessEqual] q (or\nequivalently p \[LessEqual] .50), \ ", Cell[BoxData[ \(TraditionalForm\`lim\+\(n -> \[Infinity]\)\)]], " Q[m] = 1 for all m. " }], "Text", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Palatino"], Cell[TextData[ "This limit is the famous Gambler's Ruin: When one's chance of winning \non a \ single bet is no more than .50, then the persistent gambler will eventually \n\ go broke with probability 1."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "In real gambling situations though, one usually expects to win more than \n\ $1 for each dollar bet unless the probability p of winning is close to .50. \ For a $1\nbet with a payoff of $h, one's average earnings are -1*q + h*p. \ For a fair game, \nthe average earnings should be 0; hence, h = q/p. Since \ most games are in fact \nunfair, so that the house can make a profit, we \ shall assume a payoff of $h \nwhich equals the next integer below q/p. For p \ = q though, we should assume\na fair game with h = 1."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "For example, if p = .20 and q = .80, then q/p = 4 and we take h = 3. We \ then\nlet k = 1 in the original matrix program. In other words, we either \ win $3 with \nprobability .20 or lose \ $1 with probability .80. Now suppose we wish to reach\n$30 before going \ broke with probability .60. Is it possible? If so how much \nmoney do we \ initially need? By running the program with p = .20, h = 3, k = 1, \nand n = \ 30, we obtain the following final output :\n"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[OutputFormData["\<\ {{1, {0.002054711548168111571}}, {2, {0.004419499844303345578}}, {3, {0.007141155905222170139}}, {4, {0.01027355774084055785}}, {5, {0.01387865302884428161}}, {6, {0.01802778014889746838}}, {7, {0.0228031650833141087}}, {8, {0.02829903418085917664}}, {9, {0.03462428862911021547}}, {10, {0.04190470482098066995}}, {11, {0.05028251057103944841}}, {12, {0.05992530642211437079}}, {13, {0.0710263695884624879}}, {14, {0.08379373357127456221}}, {15, {0.09849648982641406034}}, {16, {0.1154306222538549563}}, {17, {0.1348631895025228594}}, {18, {0.1573075148469720528}}, {19, {0.1831671519636185402}}, {20, {0.2125934584971944719}}, {21, {0.2470848162247688264}}, {22, {0.2866057004302044899}}, {23, {0.3302986846314981986}}, {24, {0.3850502471350662443}}, {25, {0.4446892372519471438}}, {26, {0.5050706214366730337}}, {27, {0.604056497149338427}}, {28, {0.6832451977194707417}}, {29, {0.7465961581755765933}}}\ \>", "\<\ {{1, {0.00205471}}, {2, {0.0044195}}, {3, {0.00714116}}, {4, {0.0102736}}, {5, {0.0138787}}, {6, {0.0180278}}, {7, {0.0228032}}, {8, {0.028299}}, {9, {0.0346243}}, {10, {0.0419047}}, {11, {0.0502825}}, {12, {0.0599253}}, {13, {0.0710264}}, {14, {0.0837937}}, {15, {0.0984965}}, {16, {0.115431}}, {17, {0.134863}}, {18, {0.157308}}, {19, {0.183167}}, {20, {0.212593}}, {21, {0.247085}}, {22, {0.286606}}, {23, {0.330299}}, {24, {0.38505}}, {25, {0.444689}}, {26, {0.505071}}, {27, {0.604056}}, {28, {0.683245}}, {29, {0.746596}}}\ \>"], "Output", Evaluatable->False, LineSpacing->{1, 1}, AspectRatioFixed->True], Cell[TextData[ "Hence, if we start with $27, we have just slightly more than a 60% chance \n\ of reaching $30 before going broke. By experimenting with larger and larger \ \nvalues of n, it becomes evident that there is an upper bound to the \ probability \nof reaching $n before going broke. With the above figures, \ this upper bound \nappears to be .75. Moreover, we cannot contradict the \ Gambler's Ruin. That is,\nfor a fixed initial amount m, if n-> \[Infinity], \ then P[m]-> 0 and hence Q[m] -> 1. One\nwill still eventually go broke if \ one persists in gambling. However, if one \ndecides to ``quit while you're \ ahead'', one can determine the precise probability \nof reaching the goal of \ $n before going broke! \n"], "Text", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Palatino"] }, Closed]], Cell[CellGroupData[{ Cell[TextData["Exercise"], "Section", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Palatino"], Cell["\<\ Find an estimation and confidence interval for the average ``area \ under the curve'' A[m] when starting at height m and stopping upon reaching height n or height 0. Adjust the matrix solution to find the exact value of A[m] when the steps h and k are integers. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Palatino"] }, Closed]], Cell[CellGroupData[{ Cell[TextData["Acknowledgments"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "The author would like to thank the referees for their suggestions and \n\ pointers which made the programming more efficient and elegant. "], "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData["References"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "[Chu75] K.L. Chung. Elementary Probability Theory with Stochastic \n\ Processes . Springer-Verlag, New York, 1975."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "[Fel57] W. Feller. An Introduction to Probability Theory and Its \ Applications \nVolume I, Second Edition. John Wiley & Sons, Tokyo, 1957."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "[HoTa93] R.V. Hogg and E.A. Tanis. Probability and Statistical Inference \n\ Fourth Edition. Macmillan Publishing Co., New York, 1993. \n \ "], "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData["About the Author"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "David K. Neal is an associate professor of mathematics at Western Kentucky\n\ University where he has taught for six years. His mathematical interests are\ \nin stochastic analysis and general probability. In recent years, he has \ enjoyed\nenriching his courses with a variety computer projects using \ Mathematica .\nHis other hobbies include music, sports, and felines."], "Text",\ Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "David K. Neal\nDepartment of Mathematics\nWestern Kentucky University\n\ Bowling Green, KY 42101\nnealdk @wkuvx1.wku.edu\n"], "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]] }, Open ]] }, FrontEndVersion->"NeXT 3.0", ScreenRectangle->{{0, 1053}, {0, 832}}, WindowToolbars->{}, CellGrouping->Manual, WindowSize->{520, 365}, WindowMargins->{{138, Automatic}, {Automatic, 94}}, PrivateNotebookOptions->{"ColorPalette"->{RGBColor, -1}}, ShowCellLabel->True, ShowCellTags->False, RenderingOptions->{"ObjectDithering"->True, "RasterDithering"->False} ] (*********************************************************************** Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. ***********************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[1731, 51, 137, 3, 212, "Title"], Cell[1871, 56, 312, 8, 214, "Subtitle"], Cell[2186, 66, 160, 4, 94, "Subsubtitle"], Cell[CellGroupData[{ Cell[2371, 74, 169, 5, 51, "Section"], Cell[2543, 81, 517, 8, 110, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[3097, 94, 89, 2, 32, "Section"], Cell[3189, 98, 670, 11, 126, "Text", PageBreakBelow->True], Cell[3862, 111, 772, 15, 126, "Text", PageBreakBelow->True], Cell[4637, 128, 1036, 19, 174, "Text", PageBreakBelow->True], Cell[5676, 149, 850, 15, 158, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[6563, 169, 111, 2, 32, "Section"], Cell[6677, 173, 686, 11, 142, "Text"], Cell[7366, 186, 209, 4, 46, "Text"], Cell[7578, 192, 167, 3, 84, "Input"], Cell[7748, 197, 844, 13, 174, "Text"], Cell[8595, 212, 103, 1, 48, "Input"], Cell[8701, 215, 297, 5, 132, "Input"], Cell[9001, 222, 644, 18, 78, "Text"], Cell[CellGroupData[{ Cell[9670, 244, 206, 4, 72, "Input"], Cell[CellGroupData[{ Cell[9901, 252, 12075, 520, 70, 3817, 413, "GraphicsData", "PostScript", "Graphics"], Cell[21979, 774, 13036, 489, 70, 3456, 366, "GraphicsData", "PostScript", "Graphics"] }, Closed]] }, Closed]], Cell[35042, 1267, 230, 5, 43, "Text"], Cell[CellGroupData[{ Cell[35297, 1276, 124, 3, 36, "Input"], Cell[35424, 1281, 129, 7, 70, "Output"] }, Closed]], Cell[CellGroupData[{ Cell[35590, 1293, 110, 2, 33, "Input"], Cell[35703, 1297, 156, 7, 70, "Output", PageBreakWithin->Automatic] }, Closed]], Cell[35874, 1307, 204, 4, 43, "Text"], Cell[CellGroupData[{ Cell[36103, 1315, 99, 1, 24, "Input"], Cell[36205, 1318, 129, 7, 24, "Output"] }, Closed]], Cell[CellGroupData[{ Cell[36371, 1330, 125, 3, 33, "Input"], Cell[36499, 1335, 126, 6, 70, "Output"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[36674, 1347, 98, 2, 32, "Section"], Cell[36775, 1351, 798, 12, 158, "Text"], Cell[37576, 1365, 182, 4, 46, "Text"], Cell[37761, 1371, 86, 1, 24, "Input"], Cell[37850, 1374, 59, 1, 24, "Input"], Cell[CellGroupData[{ Cell[37934, 1379, 135, 3, 48, "Input"], Cell[38072, 1384, 198, 8, 70, "Output"] }, Closed]], Cell[38285, 1395, 441, 7, 107, "Text"], Cell[38729, 1404, 670, 10, 142, "Text"], Cell[39402, 1416, 463, 8, 94, "Text"], Cell[39868, 1426, 212, 4, 60, "Input"], Cell[CellGroupData[{ Cell[40105, 1434, 82, 1, 24, "Input"], Cell[40190, 1437, 661, 20, 70, "Output"] }, Closed]], Cell[40866, 1460, 369, 6, 75, "Text"], Cell[41238, 1468, 111, 2, 36, "Input"], Cell[CellGroupData[{ Cell[41374, 1474, 118, 2, 36, "Input"], Cell[41495, 1478, 158, 7, 70, "Output"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[41702, 1491, 93, 2, 32, "Section"], Cell[41798, 1495, 866, 13, 174, "Text"], Cell[42667, 1510, 328, 6, 62, "Text"], Cell[42998, 1518, 149, 4, 30, "Text"], Cell[43150, 1524, 132, 3, 46, "Text"], Cell[43285, 1529, 619, 10, 158, "Text"], Cell[43907, 1541, 122, 2, 30, "Text"], Cell[44032, 1545, 454, 7, 126, "Text"], Cell[44489, 1554, 102, 2, 30, "Text"], Cell[44594, 1558, 420, 7, 126, "Text"], Cell[45017, 1567, 122, 2, 30, "Text"], Cell[45142, 1571, 397, 7, 126, "Text"], Cell[45542, 1580, 127, 2, 30, "Text"], Cell[45672, 1584, 348, 6, 94, "Text"], Cell[46023, 1592, 152, 4, 46, "Text"], Cell[46178, 1598, 331, 6, 94, "Text"], Cell[46512, 1606, 459, 8, 110, "Text"], Cell[46974, 1616, 888, 13, 204, "Input"], Cell[47865, 1631, 666, 18, 102, "Text"], Cell[48534, 1651, 289, 5, 62, "Text"], Cell[48826, 1658, 309, 6, 62, "Text"], Cell[49138, 1666, 153, 3, 84, "Input"], Cell[49294, 1671, 149, 4, 30, "Text"], Cell[49446, 1677, 142, 3, 48, "Input"], Cell[CellGroupData[{ Cell[49613, 1684, 54, 1, 24, "Input"], Cell[49670, 1687, 767, 31, 70, "Output"] }, Closed]], Cell[50452, 1721, 122, 2, 27, "Text"], Cell[CellGroupData[{ Cell[50599, 1727, 97, 1, 24, "Input"], Cell[50699, 1730, 206, 8, 70, "Output"] }, Closed]], Cell[50920, 1741, 809, 25, 75, "Text"], Cell[51732, 1768, 78, 1, 24, "Input"], Cell[CellGroupData[{ Cell[51835, 1773, 85, 1, 24, "Input"], Cell[51923, 1776, 525, 18, 70, "Output"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[52497, 1800, 126, 3, 31, "Section"], Cell[52626, 1805, 673, 10, 142, "Text"], Cell[CellGroupData[{ Cell[53324, 1819, 127, 3, 36, "Input"], Cell[53454, 1824, 214, 8, 70, "Output"] }, Closed]], Cell[CellGroupData[{ Cell[53705, 1837, 79, 1, 21, "Input"], Cell[53787, 1840, 212, 8, 70, "Output"] }, Closed]], Cell[54014, 1851, 830, 12, 171, "Text"], Cell[CellGroupData[{ Cell[54869, 1867, 82, 1, 24, "Input"], Cell[54954, 1870, 193, 7, 70, "Output"] }, Closed]], Cell[55162, 1880, 80, 1, 21, "Input"], Cell[CellGroupData[{ Cell[55267, 1885, 93, 1, 36, "Input"], Cell[55363, 1888, 501, 16, 70, "Output"] }, Closed]], Cell[55879, 1907, 242, 5, 43, "Text"], Cell[56124, 1914, 114, 2, 36, "Input"], Cell[56241, 1918, 137, 3, 36, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[56415, 1926, 127, 3, 31, "Section"], Cell[56545, 1931, 861, 16, 142, "Text"], Cell[57409, 1949, 262, 5, 62, "Text"], Cell[57674, 1956, 594, 9, 126, "Text"], Cell[58271, 1967, 582, 9, 126, "Text"], Cell[58856, 1978, 1688, 54, 220, "Output"], Cell[60547, 2034, 819, 13, 174, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[61403, 2052, 111, 3, 31, "Section"], Cell[61517, 2057, 361, 10, 94, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[61915, 2072, 92, 2, 32, "Section"], Cell[62010, 2076, 213, 4, 46, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[62260, 2085, 87, 2, 32, "Section"], Cell[62350, 2089, 191, 4, 46, "Text"], Cell[62544, 2095, 220, 5, 46, "Text"], Cell[62767, 2102, 262, 5, 62, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[63066, 2112, 93, 2, 32, "Section"], Cell[63162, 2116, 451, 8, 94, "Text"], Cell[63616, 2126, 198, 4, 110, "Text"] }, Closed]] }, Open ]] } ] *) (*********************************************************************** End of Mathematica Notebook file. ***********************************************************************)