(************** Content-type: application/mathematica ************** CreatedBy='Mathematica 5.1' Mathematica-Compatible Notebook This notebook can be used with any Mathematica-compatible application, such as Mathematica, MathReader or Publicon. The data for the notebook starts with the line containing 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[ 8192, 208]*) (*NotebookOutlinePosition[ 9025, 238]*) (* CellTagsIndexPosition[ 8953, 232]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{ Cell["Asian Option Implementation", "Title"], Cell["\<\ Jan Vecer, Department of Statistics, Columbia University, \ vecer@stat.columbia.edu\ \>", "Subtitle"], Cell[TextData[{ "This method can be used as a benchmark to compare with other methods for \ solving Asian options as long as you properly refer to this work and to my \ papers. The precision of this implementation depends on the build in ", StyleBox["Mathematica", FontSlant->"Italic"], " function NDSolve, and also on your choice of the cutoff points of the \ spacial boundary for the corresponding PDE. It is your responsibility to find \ the optimal cutoff points and WorkingPrecision depending on your current ", StyleBox["Mathematica", FontSlant->"Italic"], " version which works best for your parameters. For academic purposes only, \ usual disclaimer applies." }], "Subsubtitle"], Cell[TextData[{ "This is ", StyleBox["Mathematica", FontSlant->"Italic"], " implementation of my method for pricing discretely or continuously \ sampled Asian options as described in my paper Vecer, J. (2002) \"Unified \ Asian Pricing\", Risk, Vol. 15, No. 6, 113-116. The numerical precision of \ the solution is limited by ", StyleBox["Mathematica", FontSlant->"Italic"], "'s function NDSolve applied for partial differential equations. The \ precision of NDSolve has been improving for more recent versions. The \ corresponding PDE has unlimited spacial boundary, so we have to choose the \ cutoff points, which also determines the precision of the outcome. The cutoff \ points which depend on the size of the volatility and time work reasonably \ well. " }], "Text"], Cell[BoxData[ \(AsianContinuous[S_, K_, r_, \[Sigma]_, T_] := Module[{S1 = S, K1 = K, \[Sigma]1 = \[Sigma], r1 = r, T1 = T}, qcontinuous[t2_, T2_, r2_] := \((1 - Exp[\(-r2\)*t2])\)/\((r2*T2)\); solution = NDSolve[{\[PartialD]\_t u[x, t] \[Equal] 0.5*\[Sigma]1^2*\((\((1 - Exp[\(-r1\)*t])\)/\((r1*T1)\) - x)\)^2*\[PartialD]\_\(x, x\)u[x, t], u[x, 0] \[Equal] If[x > 0, x, 0], u[\(-1.0\)*\[Sigma]1*T1, t] \[Equal] 0, u[1.5*\[Sigma]1*T1, t] \[Equal] 1.5*\[Sigma]1*T1}, u, {x, \(-1.0\)*\[Sigma]1*T1, 1.5*\[Sigma]1*T1}, {t, 0, T1}]; \((S1* u[qcontinuous[T1, T1, r1] - Exp[\(-r1\)*T1]*K1/S1, T1] /. solution)\)[\([1]\)]]\)], "Input", CellTags->"NDSolve"], Cell[BoxData[ \(AsianDiscrete[S_, K_, r_, \[Sigma]_, T_, n_] := Module[{S1 = S, K1 = K, \[Sigma]1 = \[Sigma], r1 = r, T1 = T, n1 = n}, qdiscrete[t2_, T2_, r2_, n2_] := \((1/n2)\)* Sum[Exp[\(-r2\)*T2*\((n2 - k)\)/n2], {k, Floor[n2*\((T2 - t2)\)/T2] + 1, n2}]; solution = NDSolve[{\[PartialD]\_t u[x, t] \[Equal] 0.5*\[Sigma]1^2*\((qdiscrete[t, T1, r1, n1] - x)\)^2*\[PartialD]\_\(x, x\)u[x, t], u[x, 0] \[Equal] If[x > 0, x, 0], u[\(-1.0\)*\[Sigma]1*T1, t] \[Equal] 0, u[1.2*\[Sigma]1*T1, t] \[Equal] 1.2*\[Sigma]1*T1}, u, {x, \(-1.0\)*\[Sigma]1*T1, 1.2*\[Sigma]1*T1}, {t, 0, T1}]; \((S1* u[qdiscrete[T1, T1, r1, n1] - Exp[\(-r1\)*T1]*K1/S1, T1] /. solution)\)[\([1]\)]]\)], "Input", CellTags->"NDSolve"], Cell["\<\ Here is the example from the paper which is also used in many other papers as \ a benchmark. I add timing for comparison, the value depends on the computer. \ The 7 values should be computed within a fraction of a second. The precision \ is typically the first 3 decimal digits, it can be further improved by \ choosing larger cutoff points in the PDE and by increasing WorkingPrecision \ option in NDSolve function. \ \>", "Text"], Cell[CellGroupData[{ Cell["\<\ Timing[AsianTest={AsianContinuous[1.9,2,.05,.5,1],AsianContinuous[2,2,.05,.5,\ 1],AsianContinuous[2.1,2,.05,.5,1], AsianContinuous[2,2,.02,.1,1],AsianContinuous[2,2,.18,.3,1],AsianContinuous[2,\ 2,.0125,.25,2],AsianContinuous[2,2,.05,.5,2]}]\ \>", "Input"], Cell[BoxData[ \({0.5310000000000001`\ Second, {0.19226408719291868`, 0.2458576748086963`, 0.30588405119031414`, 0.056247280470202755`, 0.218121938834024`, 0.17226715690310074`, 0.3499896086848008`}}\)], "Output"] }, Open ]], Cell["\<\ Here is another numerical example from my paper for discretely sampled Asian \ options.\ \>", "Text"], Cell[CellGroupData[{ Cell["\<\ Timing[AsianDicreteTest={AsianDiscrete[95,100,.1,.4,1,10],AsianDiscrete[95,\ 100,.1,.4,1,25],AsianDiscrete[95,100,.1,.4,1,50],AsianDiscrete[95,100,.1,.4,1,\ 125],AsianDiscrete[95,100,.1,.4,1,250],AsianDiscrete[95,100,.1,.4,1,500],\ AsianDiscrete[95,100,.1,.4,1,1000],AsianContinuous[95,100,.1,.4,1]}]\ \>", "Input"], Cell[BoxData[ \({0.5779999999999998`\ Second, {9.237433275135691`, 8.71912293500854`, 8.51957761642852`, 8.409985111659326`, 8.3844475017695`, 8.362968403491296`, 8.355776246952509`, 8.348798437260365`}}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell["\<\ Timing[AsianDicreteTest={AsianDiscrete[100,100,.1,.4,1,10],AsianDiscrete[100,\ 100,.1,.4,1,25],AsianDiscrete[100,100,.1,.4,1,50],AsianDiscrete[100,100,.1,.4,\ 1,125],AsianDiscrete[100,100,.1,.4,1,250],AsianDiscrete[100,100,.1,.4,1,500],\ AsianDiscrete[100,100,.1,.4,1,1000],AsianContinuous[100,100,.1,.4,1]}]\ \>", "Input"], Cell[BoxData[ \({0.5790000000000002`\ Second, {12.069301978488456`, 11.51252947469641`, 11.299016454827084`, 11.180557468327605`, 11.153115054618427`, 11.129271160585212`, 11.120911011096762`, 11.114265696746655`}}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell["\<\ Timing[AsianDicreteTest={AsianDiscrete[105,100,.1,.4,1,10],AsianDiscrete[105,\ 100,.1,.4,1,25],AsianDiscrete[105,100,.1,.4,1,50],AsianDiscrete[105,100,.1,.4,\ 1,125],AsianDiscrete[105,100,.1,.4,1,250],AsianDiscrete[105,100,.1,.4,1,500],\ AsianDiscrete[105,100,.1,.4,1,1000],AsianContinuous[105,100,.1,.4,1]}]\ \>", "Input"], Cell[BoxData[ \({0.5780000000000003`\ Second, {15.256109434091012`, 14.677909668202663`, 14.457796897361849`, 14.33506349516815`, 14.306055330101012`, 14.282527839528402`, 14.27137421889693`, 14.26582506510942`}}\)], "Output"] }, Open ]] }, Open ]] }, FrontEndVersion->"5.1 for Microsoft Windows", ScreenRectangle->{{0, 1600}, {0, 1117}}, WindowSize->{992, 787}, WindowMargins->{{Automatic, 136}, {Automatic, 9}} ] (******************************************************************* 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->{ "NDSolve"->{ Cell[3435, 93, 836, 15, 110, "Input", CellTags->"NDSolve"], Cell[4274, 110, 920, 17, 130, "Input", CellTags->"NDSolve"]} } *) (*CellTagsIndex CellTagsIndex->{ {"NDSolve", 8786, 223} } *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[1776, 53, 44, 0, 95, "Title"], Cell[1823, 55, 111, 3, 51, "Subtitle"], Cell[1937, 60, 704, 13, 112, "Subsubtitle"], Cell[2644, 75, 788, 16, 90, "Text"], Cell[3435, 93, 836, 15, 110, "Input", CellTags->"NDSolve"], Cell[4274, 110, 920, 17, 130, "Input", CellTags->"NDSolve"], Cell[5197, 129, 441, 7, 71, "Text"], Cell[CellGroupData[{ Cell[5663, 140, 266, 5, 48, "Input"], Cell[5932, 147, 243, 4, 29, "Output"] }, Open ]], Cell[6190, 154, 111, 3, 33, "Text"], Cell[CellGroupData[{ Cell[6326, 161, 325, 5, 66, "Input"], Cell[6654, 168, 248, 4, 29, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[6939, 177, 333, 5, 66, "Input"], Cell[7275, 184, 259, 4, 29, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[7571, 193, 333, 5, 66, "Input"], Cell[7907, 200, 257, 4, 29, "Output"] }, Open ]] }, Open ]] } ] *) (******************************************************************* End of Mathematica Notebook file. *******************************************************************)