Problem in simulating discrete time stochastic

Question

I have been playing with some stochastic questions and specially the problem here.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?

timstep = 5;
win = BinomialProcess[.99];
samplepaths = 1;
process = RandomFunction[Evaluate[win], {0, timstep - 1}, samplepaths];
ListLinePlot[process, Frame -> False, 
AxesLabel -> {Style["Time Step", Bold], Style["Number", Bold]}, 
PlotStyle -> {{Dashed, Black, Opacity[.9]}}, ImageSize -> 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.] &, 
x1, Prepend[Differences@WinEvents, First@WinEvents]]];
simdat = ST[#, x1, alpha, timstep] & /@ WinEvents; Show[
ListLinePlot[Legended[Mean[simdat], ""], PlotRange -> All, 
PlotStyle -> {{AbsoluteThickness[3.5], Opacity[.9], Red}}, 
ImageSize -> 600], 
ListLinePlot[simdat, PlotRange -> All, 
PlotStyle -> {{Dashed, Black, Opacity[.7]}}], 
ListPlot[simdat, PlotRange -> All], Frame -> True]

Answer 1

EDITED

Alex, I believe this is what you want:

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)] & /@ 
  Range[Time]], {x, 1, NumberOfProcesses}];
  ListLinePlot[Transpose[{Range[0, Time], Mean[paths]}], 
  PlotRange -> All]

However, I would advise your to simulate your paths using log-returns (instead of simple returns). This should help:

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]] & /@ 
  Range[Time]], {x, 1, NumberOfProcesses}];
  ListLinePlot[Transpose[{Range[0, Time], Mean[paths]}], 
  PlotRange -> All]

EDITED

Alex, to "prove" that arithmetic returns (i.e., gamblers wealth using arithmetic percent increase/decrease) are downwards biased, consider the comparison between log(geometric) returns and arithmetic returns:

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)] & /@ Range[Time]], 
    {x, 1, NumberOfProcesses}];
GeometricPaths = Table[FoldList[Times, StartingWealth, 
  If[Differences[Last[Transpose[processes["Path", x]]]][[#]] == 1, 
  Exp[PercentChange], Exp[-PercentChange]] & /@ Range[Time]], 
  {x, 1, NumberOfProcesses}];
ListLinePlot[
  {Transpose[{Range[0, Time], Mean[GeometricPaths]}],
  Transpose[{Range[0, Time], Mean[ArithmeticPaths]}]}, 
    PlotRange -> All, PlotStyle -> {{Thick, Blue}, {Thick, Red}}, 
    PlotLegends -> {"Geometric Returns", "Arithmetic Returns"}]

++++++++++++++++++++++++++++++++++

Alex, I believe there are two main problems in your simulation.

FIRST PROBLEM

You're interested in computing the mean of the processes. So, you have to be aware of the fact that Mathematica will actually plot the mean of the processes in a different time scale than that of your processes. For instance, to simulate two processes for a 5-period timestep you can write

processes = RandomFunction[BinomialProcess[.5], {0, 5}, 2]

This will return a TemporalData[] object. Now consider to "open" this TemporalData[] object:

processes["Path", 1]
processes["Path", 2]

and you will get something like

{{0, 0}, {1, 0}, {2, 1}, {3, 1}, {4, 2}, {5, 2}}

{{0, 0}, {1, 0}, {2, 0}, {3, 0}, {4, 1}, {5, 1}}

Now you can see that the first simulated values occur always at time zero and its value will also (always) be zero (i.e., {0, 0}).

Now consider taking the mean of the processes:

Mean[processes["States"]]

and you will get something like

{0, 1, 3/2, 2, 5/2, 3}

Now if you plot the mean vector the first value will start at time one and will end at time six, while the processes themselves will start at time zero and will end - correctly - at time five. See:

ListLinePlot[processes, AxesOrigin -> {0, 0}];
ListLinePlot[Mean[processes["States"]], AxesOrigin -> {0, 0}];

So, instead of using Mean[processes["States"]], you should use

Mean[processes["Paths"]]

and your plot will be correct:

ListLinePlot[Mean[processes["Paths"]]]

SECOND PROBLEM

In order to compute the "wealth over time" of the gambler you have to be aware of the difference between normal returns and logarithmic returns.

You can find a very interesting introduction here.

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 never 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.

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 downwards.

However, if you use Log-Returns the gambler's wealth can be correctly computed. Consider, for instance, an initial log-return of -50%:

100*Exp[-.5]

60.6531

After a log-return of +50% the gambler will have the original wealth:

%*Exp[.5]

100.

Now, consider that the gambler will gain +50% at the first moment

100*Exp[.5]

164.872

If he log-loses 50% he will have the original wealth back:

%*Exp[-.5]

100.

Answer 2

Change your process definition to:

process = RandomFunction[Evaluate[win], {1, timstep}, samplepaths];

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:

which has all increasing values because the coefficient of the binomial is 0.99