Simplifying the Black Scholes Equation

Questions
, , ,
1

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.

2 
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])]

gives

-(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 +
4*Log[s/k]^2)/(8*sigma^2*t))*Sqrt[2*Pi])
3

Thanks for this Rolf! I need to take this apart a bit to understand it, but that’s exactly what I need as output!