Problem in simulating discrete time stochastic - Mathematica Stack Exchange most recent 30 from mathematica.stackexchange.com 2019-10-14T00:10:31Z https://mathematica.stackexchange.com/feeds/question/27943 https://creativecommons.org/licenses/by-sa/4.0/rdf https://mathematica.stackexchange.com/q/27943 1 Problem in simulating discrete time stochastic Alex https://mathematica.stackexchange.com/users/7035 2013-07-02T00:06:27Z 2013-07-02T18:15:32Z <p>I have been playing with some stochastic questions and specially the problem <a href="https://mathematica.stackexchange.com/questions/23317/simulating-discrete-time-stochastic-dynamic-systems">here</a>.It seems no matter for the first time in bet, gambler is going to lose the first bet.Am I right?How can we correct the algorithm here?</p> <pre><code>timstep = 5; win = BinomialProcess[.99]; samplepaths = 1; process = RandomFunction[Evaluate[win], {0, timstep - 1}, samplepaths]; ListLinePlot[process, Frame -&gt; False, AxesLabel -&gt; {Style["Time Step", Bold], Style["Number", Bold]}, PlotStyle -&gt; {{Dashed, Black, Opacity[.9]}}, ImageSize -&gt; 600] x1 = 100; alpha = 0.5;(*assume some value for alpha*)WinEvents = process["States"]; ST[WinEvents_?ListQ, x1_, alpha_, SimTime_] := Module[{}, FoldList[Max[If[#2 == 1, (1 + alpha) #1, (1 - alpha) #1], 0.] &amp;, x1, Prepend[Differences@WinEvents, First@WinEvents]]]; simdat = ST[#, x1, alpha, timstep] &amp; /@ WinEvents; Show[ ListLinePlot[Legended[Mean[simdat], ""], PlotRange -&gt; All, PlotStyle -&gt; {{AbsoluteThickness[3.5], Opacity[.9], Red}}, ImageSize -&gt; 600], ListLinePlot[simdat, PlotRange -&gt; All, PlotStyle -&gt; {{Dashed, Black, Opacity[.7]}}], ListPlot[simdat, PlotRange -&gt; All], Frame -&gt; True] </code></pre> <p><img src="https://i.stack.imgur.com/ZN71z.jpg" alt="enter image description here"> <img src="https://i.stack.imgur.com/KFKOH.jpg" alt="enter image description here"></p> https://mathematica.stackexchange.com/questions/27943/-/27955#27955 2 Answer by bill s for Problem in simulating discrete time stochastic bill s https://mathematica.stackexchange.com/users/1783 2013-07-02T07:44:40Z 2013-07-02T13:29:38Z <p>Change your process definition to:</p> <pre><code>process = RandomFunction[Evaluate[win], {1, timstep}, samplepaths]; </code></pre> <p>and you will avoid the first (zero) step. This is (I suspect) what Andy Ross was saying. The output of the above code (with the process defined as above) is the plot:</p> <p><img src="https://i.stack.imgur.com/J1sD1.png" alt="enter image description here"></p> <p>which has all increasing values because the coefficient of the binomial is 0.99</p> https://mathematica.stackexchange.com/questions/27943/-/27958#27958 4 Answer by Rod for Problem in simulating discrete time stochastic Rod https://mathematica.stackexchange.com/users/5369 2013-07-02T08:29:35Z 2013-07-02T14:31:07Z <p><strong>EDITED</strong></p> <p>Alex, I believe this is what you want:</p> <pre><code>StartingWealth = 100; PercentChange = 0.5; WinProbability = .5; NumberOfProcesses = 2; Time = 5; processes = RandomFunction[BinomialProcess[WinProbability], {0, Time}, NumberOfProcesses]; paths = Table[ FoldList[Times, StartingWealth, If[Differences[Last[Transpose[processes["Path", x]]]][[#]] == 1, (1 + PercentChange), (1 - PercentChange)] &amp; /@ Range[Time]], {x, 1, NumberOfProcesses}]; ListLinePlot[Transpose[{Range[0, Time], Mean[paths]}], PlotRange -&gt; All] </code></pre> <p><img src="https://i.stack.imgur.com/CqfmB.jpg" alt="enter image description here"></p> <p>However, I would advise your to simulate your paths using log-returns (instead of simple returns). This should help:</p> <pre><code>StartingWealth = 100; PercentChange = 0.5; WinProbability = .5; NumberOfProcesses = 2; Time = 5; processes = RandomFunction[BinomialProcess[WinProbability], {0, Time}, NumberOfProcesses]; paths = Table[ FoldList[Times, StartingWealth, If[Differences[Last[Transpose[processes["Path", x]]]][[#]] == 1, Exp[PercentChange], Exp[-PercentChange]] &amp; /@ Range[Time]], {x, 1, NumberOfProcesses}]; ListLinePlot[Transpose[{Range[0, Time], Mean[paths]}], PlotRange -&gt; All] </code></pre> <p><img src="https://i.stack.imgur.com/k0QjM.jpg" alt="enter image description here"></p> <p><strong>EDITED</strong></p> <p>Alex, to "prove" that arithmetic returns (i.e., gamblers wealth using arithmetic percent increase/decrease) are <strong>downwards</strong> biased, consider the comparison between log(geometric) returns and arithmetic returns:</p> <pre><code>StartingWealth = 100; PercentChange = .5; WinProbability = .5; NumberOfProcesses = 5; Time = 20; processes = RandomFunction[BinomialProcess[WinProbability], {0, Time}, NumberOfProcesses]; ArithmeticPaths = Table[FoldList[Times, StartingWealth, If[Differences[Last[Transpose[processes["Path", x]]]][[#]] == 1, (1 + PercentChange), (1 - PercentChange)] &amp; /@ Range[Time]], {x, 1, NumberOfProcesses}]; GeometricPaths = Table[FoldList[Times, StartingWealth, If[Differences[Last[Transpose[processes["Path", x]]]][[#]] == 1, Exp[PercentChange], Exp[-PercentChange]] &amp; /@ Range[Time]], {x, 1, NumberOfProcesses}]; ListLinePlot[ {Transpose[{Range[0, Time], Mean[GeometricPaths]}], Transpose[{Range[0, Time], Mean[ArithmeticPaths]}]}, PlotRange -&gt; All, PlotStyle -&gt; {{Thick, Blue}, {Thick, Red}}, PlotLegends -&gt; {"Geometric Returns", "Arithmetic Returns"}] </code></pre> <p><img src="https://i.stack.imgur.com/O3f6o.jpg" alt="enter image description here"></p> <p>++++++++++++++++++++++++++++++++++</p> <p>Alex, I believe there are two main problems in your simulation.</p> <p><strong>FIRST PROBLEM</strong></p> <p>You're interested in computing the <strong>mean</strong> of the processes. So, you have to be aware of the fact that <em>Mathematica</em> will actually plot the mean of the processes in a <strong>different time scale</strong> than that of your processes. For instance, to simulate two processes for a 5-period timestep you can write</p> <pre><code>processes = RandomFunction[BinomialProcess[.5], {0, 5}, 2] </code></pre> <p>This will return a <code>TemporalData[]</code> object. Now consider to "open" this <code>TemporalData[]</code> object:</p> <pre><code>processes["Path", 1] processes["Path", 2] </code></pre> <p>and you will get something like</p> <blockquote> <p>{{0, 0}, {1, 0}, {2, 1}, {3, 1}, {4, 2}, {5, 2}}</p> <p>{{0, 0}, {1, 0}, {2, 0}, {3, 0}, {4, 1}, {5, 1}}</p> </blockquote> <p>Now you can see that the <strong>first</strong> simulated values occur <strong>always</strong> at <strong>time zero</strong> and its value will also (always) be <strong>zero</strong> (i.e., <code>{0, 0}</code>).</p> <p>Now consider taking the <strong>mean</strong> of the processes:</p> <pre><code>Mean[processes["States"]] </code></pre> <p>and you will get something like</p> <blockquote> <p>{0, 1, 3/2, 2, 5/2, 3}</p> </blockquote> <p>Now if you <strong>plot</strong> the mean vector the first value will start at <strong>time one</strong> and will end at time <strong>six</strong>, while the processes themselves will start at time zero and will end - correctly - at time five. See:</p> <pre><code>ListLinePlot[processes, AxesOrigin -&gt; {0, 0}]; ListLinePlot[Mean[processes["States"]], AxesOrigin -&gt; {0, 0}]; </code></pre> <p><img src="https://i.stack.imgur.com/UF7EU.jpg" alt="enter image description here"></p> <p><img src="https://i.stack.imgur.com/OGSUR.jpg" alt="enter image description here"></p> <p>So, instead of using <code>Mean[processes["States"]]</code>, you should use </p> <pre><code>Mean[processes["Paths"]] </code></pre> <p>and your plot will be correct:</p> <pre><code>ListLinePlot[Mean[processes["Paths"]]] </code></pre> <p><img src="https://i.stack.imgur.com/RaX4P.jpg" alt="enter image description here"></p> <p><strong>SECOND PROBLEM</strong></p> <p>In order to compute the "wealth over time" of the gambler you have to be aware of the difference between <strong>normal returns</strong> and <strong>logarithmic returns</strong>. </p> <p>You can find a very interesting introduction <a href="http://faculty.washington.edu/ezivot/econ424/returnCalculations.pdf" rel="nofollow noreferrer">here</a>.</p> <p>In your simulation you use $(1+\alpha)$ and $(1-\alpha)$ while computing the wealth of the gambler. This leads you to a serious problem, because a gambler with starting wealth of $100$ after losing 50% will <strong>never</strong> come back to the original value after a gain of 50%. He will have to gain 100% (after losing 50%) to come back to the original value.</p> <p>In this case, if you use $(1+\alpha)$ and $(1-\alpha)$ (where $\alpha$ represents a fixed percent gain/loss) you will be biasing the gambler's wealth <strong>downwards</strong>.</p> <p>However, if you use Log-Returns the gambler's wealth can be correctly computed. Consider, for instance, an initial log-return of -50%:</p> <pre><code>100*Exp[-.5] </code></pre> <blockquote> <p>60.6531</p> </blockquote> <p>After a log-return of +50% the gambler will have the original wealth:</p> <pre><code>%*Exp[.5] </code></pre> <blockquote> <p>100.</p> </blockquote> <p>Now, consider that the gambler will gain +50% at the first moment</p> <pre><code>100*Exp[.5] </code></pre> <blockquote> <p>164.872</p> </blockquote> <p>If he log-loses 50% he will have the original wealth back:</p> <pre><code>%*Exp[-.5] </code></pre> <blockquote> <p>100.</p> </blockquote>