WOLFRAM

Wolfram Language & System Documentation Center

Strong Convergence of Euler–Maruyama Approximation Scheme

Generate a coarse Brownian motion path and its refinements:
Wolfram Language code: RefineWienerPath[td_TemporalData] := Module[{times, paths, paths2}, times = td["TimeList"]; paths = td["ValueList"]; 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] ]
Wolfram Language code: ExactGBM[{mu_, si_, x0_}, bm_TemporalData] := TemporalData[x0 Exp[(mu - si ^ 2 / 2)bm["TimeList"] + bm["ValueList"]si], First[bm["RawTimes"]]]
Wolfram Language code: 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["TimeList"]; paths = bm["ValueList"]; 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"]]] ]
Wolfram Language code: BlockRandom[SeedRandom[11132012]; bms = NestList[RefineWienerPath, RandomFunction[WienerProcess[], {0, 1, .5}], 8]];
Wolfram Language code: ems = EMAlgo[ItoProcess[GeometricBrownianMotionProcess[2, 1, 2.]], #]& /@ bms; exacts = ExactGBM[{2, 1, 2.}, #]& /@ bms;
Euler–Maruyama approximation of the geometric Brownian motion process path for a given underlying Wiener process path, compared to the exact path:
Wolfram Language code: Labeled[Partition[MapThread[ListLinePlot[{#1, #2}, PlotLabel -> Row[{"Δt", "==", HoldForm[2 ^ (-#3)]}, " "]]&, {ems, exacts, Range[9]}], 3]//Grid, LineLegend[{ColorData[97, 1], ColorData[97, 2]}, {Style[Text["Euler‐Murayama approximation "], Larger], Style[Text["Exact path"], Larger]}, LegendLayout -> "Row"], Top]