Option Playground

It's important to understand the dependence of variables with each other when thinking about options. This post is designed to let anyone explore the various curves of Black Scholes while changing any option parameter.

You will need the CDF Player to use the tools below. I understand it's a pain to install extra software, but the power and simplicity of the CDF document was perfect for creating these programs. I list the code below for anyone else interested in replicating in Mathematica.

After installing the CDFs, I see that they're fragile, and they're not initializing properly. You will have to drag the Strike slider over from the minimum value for it to give reasonable output. I'm also not sure why the second and fourth CDFs decided to output smaller than the other two. I will have to rewrite these programs with something that's more reliable. I also discovered that CDFs don't play in Chrome anymore, and Wolfram has not fixed this yet.

Manipulate[DynamicModule[{mp, x, y, epi},
  mp = MousePosition["Graphics"];
  If[mp === None,
   epi = {},
   {x, y} = mp;
   epi = "Price = " <> ToString[x] <> "\n" <> fnames[fcn] <> " = " <> 
     ToString[fcn[x, K, \[Sigma], r, T]];
   ];
  Plot[fcn[S, K, \[Sigma], r, T], {S, lb, ub}, ImageSize -> Large,
   PlotLabel -> 
    "Price Space\n" <> ToString[K] <> " Strike, " <> 
     ToString[\[Sigma]*100] <> "% Vol, " <> ToString[r*100] <> 
     "% Int, " <> ToString[T] <> " Years",
   Epilog -> {If[mp === None, {}, Tooltip[Point[{x, y}], epi]]}
   ]
  ],
 Style["Option Curves Given Changes in Spot Price\n", 12, Bold],
 {{fcn, Call, "Plot"}, Normal[fnames]},
 {{K, 100, "Strike"}, 5, 150, 5},
 {{\[Sigma], 0.2, "Volatility"}, 0.01, 0.9},
 {{r, 0.01, "Short Rate"}, 0.001, 0.1},
 {{T, 0.5, "Time"}, 0.001, 2},
 {{lb, K/2, "Lower Price"}, 0.01, K},
 {{ub, K*1.5, "Upper Price"}, K, 3*K},
 Initialization :> (
   d12[S_, K_, \[Sigma]_, r_, T_, d_] := 
    Log[S*Exp[r*T]/K]/(\[Sigma]*Sqrt[T]) + d*\[Sigma]*Sqrt[T]/2;
          NN[x_] := CDF[NormalDistribution[0, 1], x];
          NP[x_] := PDF[NormalDistribution[0, 1], x];
          
   Call[S_, K_, \[Sigma]_, r_, T_] := 
    S*NN[d12[S, K, \[Sigma], r, T, 1]] - 
     K*Exp[-r*T]*NN[d12[S, K, \[Sigma], r, T, -1]];
          
   PutO[S_, K_, \[Sigma]_, r_, 
     T_] := -S*NN[-d12[S, K, \[Sigma], r, T, 1]] + 
     K*Exp[-r*T]*NN[-d12[S, K, \[Sigma], r, T, -1]];
          
   CDelta[S_, K_, \[Sigma]_, r_, T_] := 
    NN[d12[S, K, \[Sigma], r, T, 1]];
          
   PDelta[S_, K_, \[Sigma]_, r_, T_] := 
    1 - CDelta[S, K, \[Sigma], r, T];
          
   CGamma[S_, K_, \[Sigma]_, r_, T_] := 
    NP[d12[S, K, \[Sigma], r, T, 1]]/(S*\[Sigma]*Sqrt[T]);
          
   Vega[S_, K_, \[Sigma]_, r_, T_] := 
    S*Sqrt[T]*NP[d12[S, K, \[Sigma], r, T, 1]];
          
   Theta[S_, K_, \[Sigma]_, r_, T_] := -K*
     Exp[-r*T]*(r*NN[d12[S, K, \[Sigma], r, T, -1]] + \[Sigma]*
        NP[d12[S, K, \[Sigma], r, T, -1]]/(2*Sqrt[T]));
          
   Rho[S_, K_, \[Sigma]_, r_, T_] := 
    T*K*Exp[-r*T]*NN[d12[S, K, \[Sigma], r, T, -1]];
   fnames = <|Call -> "Call Price", PutO -> "Put Price", 
     CDelta -> "Call Delta", PDelta -> "Put Delta", CGamma -> "Gamma",
      Vega -> "Vega", Theta -> "Theta", Rho -> "Rho"|>;
   )
 ]