Message Boards Message Boards


Simplifying the Black Scholes Equation

Posted 11 years ago
2 Replies
3 Total Likes
After watching one of the Wolfram Finance Platform videos from Michael Kelly I found out how to write the Black Scholes equation in Mathematica, in terms of N the CDF of the Normal Distribution and the two auxiliary equations. My code has been converted to InputForm, it'll be easier to read as StandardForm.
cdfDist[x_] := CDF[NormalDistribution[], x];

auxEqu1[s_, sigma_, k_, t_, r_, q_] := (Log[s/k] + t*(r - q))/(sigma*Sqrt[t]) + (sigma*Sqrt[t])/2;
auxEqu2[s_, sigma_, k_, t_, r_, q_] := (Log[s/k] + t*(r - q))/(sigma*Sqrt[t]) - (sigma*Sqrt[t])/2;
And finally,
BlackScholesCall[s_, k_, v_, r_, q_, t_] :=
   s E^(-q t) cdfDist[auxEqu1[s, v, k, t, r, q]] - k E^(-r t) cdfDist[auxEqu2[s, v, k, t, r, q]];

BlackScholesPut[s_, k_, v_, r_, q_, t_] :=
   k E^(-r t) cdfDist[-auxEqu2[s, v, k, t, r, q]] - s E^(-q t) cdfDist[-auxEqu1[s, v, k, t, r, q]];
I then followed Michael's instructions to compute a first-order differential analysis of the Black Scholes Theta Call and Put, i.e. the total derivative of the BlackScholesCall and Put with respect to the following rules:
SetAttributes[{s, k, q}, Constant];
stochasticRules = {Dt[r, {t}] -> Subscript[alpha, r], Dt[sigma, {t}] -> Subscript[alpha, sigma]};
And finally evaluating:
StochasticCallTheta[s_, k_, sigma_, r_, q_, t_] =
   -Evaluate[Dt[BlackScholesCall[s, k, sigma, r, q, t], {t}]] /. stochasticRules;

StochasticPutTheta[s_, k_, sigma_, r_, q_, t_] =
   -Evaluate[Dt[BlackScholesPut[s, k, sigma, r, q, t], {t}]] /. stochasticRules;

Simplify[StochasticCallTheta[s, k, sigma, r, q, t]]
However, the final output is in terms of s, k, sigma, r, q and t. When I'm speaking with people in the Financial Engineering community they expect to see the output in terms of the two auxiliary equations I defined above (auxEqu1, auxEqu2).  I looked through the Documentation to see if there was a "simplify and substitute" function, but couldn't find one. This is essentially want I want to do in Mathematica syntax
Simplify[StochasticCallTheta //. Thread[{ (Log[s/k] + t*(r - q))/(sigma*Sqrt[t]) +
   (sigma*Sqrt[t])/2, (Log[s/k] + t*(r - q))/(sigma*Sqrt[t]) -
   (sigma*Sqrt[t])/2} ->{auxiliary1,auxiliary2}]
But the ReplaceRepeated doesn't work like that because it only sees patterns. I don't mind having to write two or three lines to persuade Mathematica into transforming the output of StochasticCallTheta in terms of the auxiliary equations, but I just can't think of how to even start.
POSTED BY: Martin Hadley
2 Replies
Thanks for this Rolf! I need to take this apart a bit to understand it, but that's exactly what I need as output!
POSTED BY: Martin Hadley
Simplify[Factor //@ Simplify[StochasticCallTheta[s, k, sigma, r, q, t]] /.
(Factor /@ Thread[{(Log[s/k] + t*(r - q))/(sigma*Sqrt[t]) +
(sigma*Sqrt[t])/2, (Log[s/k] + t*(r - q))/(sigma*Sqrt[t]) -
(sigma*Sqrt[t])/2} -> {auxiliary1, auxiliary2}] /.
(a_ -> b_) :> a*Denominator[a] -> b*Denominator[a] /.
(a_ -> b_) :> Sequence[a -> b, -a -> -b])]

 -(k*(s/k)^(1/2 + q/sigma^2 - r/sigma^2)*sigma)/
 (2*E^(((4*q^2 + (2*r + sigma^2)^2 + q*(-8*r + 4*sigma^2))*t^2 +
 4*Log[s/k]^2)/(8*sigma^2*t))*Sqrt[2*Pi]*Sqrt) +
 (q*s*Erfc[-(auxiliary1/Sqrt[2])])/(2*E^(q*t)) -
 (k*r*Erfc[-(auxiliary2/Sqrt[2])])/(2*E^(r*t)) -
 (k*t*Erfc[-(auxiliary2/Sqrt[2])]*Subscript[alpha, r])/(2*E^(r*t)) -
 (k*(s/k)^(1/2 + q/sigma^2 - r/sigma^2)*Sqrt*Subscript[alpha, sigma])/
 (E^(((4*q^2 + (2*r + sigma^2)^2 + q*(-8*r + 4*sigma^2))*t^2 +
POSTED BY: Rolf Mertig
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
or Discard

Group Abstract Group Abstract