« View all new features in
Mathematica
9
◄
previous

next
►
New in
Mathematica
9
›
Time Series and Stochastic Differential Equations
Strong Convergence of EulerMaruyama Approximation Scheme
Generate a coarse Brownian motion path and its refinements.
In[1]:=
X
RefineWienerPath[td_TemporalData] := Module[{times, paths, paths2}, times = td["Times"]; paths = td["States"]; paths2 = {paths[[All, 1 ;; 2]], Divide[ListConvolve[{{1, 1}}, paths] + Sqrt[Differences[times, {0, 1}]] RandomVariate[ NormalDistribution[], Dimensions[times]  {0, 1}], 2]}; TemporalData[ Join[Flatten[Transpose[paths2, {3, 1, 2}], {{1}, {2, 3}}], paths[[All, {1}]], 2], {Riffle[#, MovingAverage[#, 2]]} & /@ times] ]
In[2]:=
X
ExactGBM[{mu_, si_, x0_}, bm_TemporalData] := TemporalData[x0 Exp[(mu  si^2/2) bm["Times"] + bm["States"] si], First[bm["RawTimes"]]]
In[3]:=
X
EMAlgo[pr_ItoProcess, bm_TemporalData] := Module[{a, b, c, xv, x0, t, t0, times, paths, dts, dbs, tis, tc, xc, xbag}, {{a}, {{b}}, c} = pr[[1]]; {xv, x0} = pr[[2]]; {t, t0} = pr[[3]]; {a, b, c} = {a, b, c} /. Thread[Through[xv[t]] > xv]; times = bm["Times"]; paths = bm["States"]; xbag = {}; Do[ tis = Part[times, k]; dts = Differences[tis]; dbs = Differences[Part[paths, k]]; xbag = {xbag, xc = x0}; Do[ tc = Part[tis, m]; xc = xc + (a /. Join[{t > tc}, Thread[xv > xc]]) Part[dts, m] + (b /. Join[{t > tc}, Thread[xv > xc]]) Part[dbs, m]; xbag = {xbag, xc}; , {m, 1, Length[tis]  1}]; , {k, 1, Length[times]}]; TemporalData[Partition[Flatten[xbag], Last[Dimensions[times]]], First[bm["RawTimes"]]] ]
In[6]:=
X
Labeled[Partition[ MapThread[ ListLinePlot[{#1, #2}, PlotLabel > Row[{"\[CapitalDelta]t", "\[Equal]", HoldForm[2^(#3)]}, " "]] &, {ems, exacts, Range[9]}], 3] // Grid, LineLegend[{ColorData[1, 1], ColorData[1, 2]}, {Style[ Text["Euler\[Hyphen]Murayama approximation "], Larger], Style[Text["Exact path"], Larger]}, LegendLayout > "Row"], Top]
In[4]:=
X
BlockRandom[SeedRandom[11132012]; bms = NestList[RefineWienerPath, RandomFunction[WienerProcess[], {0, 1, .5}], 8]];
In[5]:=
X
ems = EMAlgo[ ItoProcess[GeometricBrownianMotionProcess[2, 1, 2.]], #] & /@ bms; exacts = ExactGBM[{2, 1, 2.}, #] & /@ bms;
EulerMaruyama approximation of the geometric Brownian motion process path for a given underlying Wiener process path, compared to the exact path.
Out[6]=