Taming Cox-Ross-Rubinstein Trees

(c) Weber & Partner, financial technology,
www.weber-und-partner.com

<< Statistics`
<< Graphics`

Implementing a CRR tree in Mathematica

Implementing Cox/Ross/Rubinstein trees for option valuation is discussed in Shaw (1998). Using the functionality which is available in Version 4 of Mathematica the following very fast implementation for european options is possible (to price american options only two slight modifications are necessary):

CRRBinomial[S_, X_, σ_, τ_, r_, 
        n_:  200]  := 
 
      Module[{u, d, p, q, Δt, δ, 
          VT}, 
Δt  =  (τ/n); 
u  = ((Δt (σ^2))/2) - (Sqrt[Δ])t σ + 1; 
d  =  
          1/u; 
p  = 
          (1/2) +  (((Sqrt[Δ])t ((σ^2) - 2 r))/(4 σ)); 
q  =  
          1 - p; 
δ  =  (E^(-r Δt)); 
VT  =  
          Table[Max[S (d^j) (u^(n - j)) - X, 0], {j, 0, 
              n}]; 
 
        Nest[ListConvolve[δ {q, p}, #] &, VT, n] //  
          First
]

Using some data to test the result gives the following result.

(Subscript[S, 0])  =  50. ;     
X  =  60. ;       
σ  =  0.2;        
τ  =  1.0;         
r    =  0.05;      
CRRBinomial[(Subscript[S, 0]), X, σ, τ, r]  //  Timing

To get a feeling for the accuracy of this value we implement the Black-Scholes formula.

Norm[x_]   :=  
      CDF[NormalDistribution[], x] 
     
Call[S_, X_, σ_, τ_, r_]  := 
      Module[{d}, 
(Subscript[d, 1]) =  ((Log[(S/X)] +  (r + (1/2) (σ^2)) τ)/(σ (Sqrt[ τ]))); 
(Subscript[d, 2]) =  
          (Subscript[d, 1 ]) -  σ (Sqrt[ τ]); 
 
        S Norm[(Subscript[d, 1])]  -  
          X (E^(-r τ)) Norm[(Subscript[d, 2])] ]

and calculate the analytical value.

bs =Call[(Subscript[S, 0]), X, σ, τ, 
        r]

Oscillating behavior

It is well known that the binomial methods does not converge perfectly. Instead it shows oscillating behavior (see Omberg (1987)). These oscillations are present even if the number of steps is quite high. Following Shaw (1998) it is quite simple to visulize these oscillations. (Before starting the next input line in Mathematica be aware that there quite a lot of calculation you demand. So allow Mathematica some seconds to finish the calculations.)

data  =  
        Table[{n, CRRBinomial[(Subscript[S, 0]), X, σ, τ, r, n]}, {n, 50, 
            250}]; 
ListPlot[data, PlotJoined -> True, AspectRatio -> 0.5, 
        PlotRange -> {1.6, 1.63}, 
        Epilog -> {Red, Line[{{50, bs}, {250, bs}}]}];

The red line describes the analytical solution.

To reduce the oscillations some trading systems allow to take the mean of steps n and n + 1 when valuing options with binomial trees. valuation methods. This procedure leads to the following picture.

Apply[Plus, Partition[data, 2], 1]/2. ;
ListPlot[%, PlotJoined -> True, AspectRatio -> 0.5, 
        PlotRange -> {1.6, 1.63}, 
        Epilog -> {Red, Line[{{50, bs}, {250, bs}}]}];

As can be seen from the picture taking the mean of the result of successiv number of steps is not yet the solution of the problem.

Improving the convergence behavior

From a participant of our last training in Zurich we were reminded on an improvement to the tree which reduces the oscillation behavior quite drastic. When instead of the known option prices at maturity of the option the prices calculated with the Black-Scholes formula one step before maturity are taken as the starting value for working backwards through the tree (see the following implementation) the oscillation vanishes almost completely.

ImprovCRRBinomial[S_, X_, σ_, τ_, r_, 
        n_:  200]  := 
 
      Module[{u, d, p, q, Δt, δ, 
          VT, }, 
Δt  =  (τ/n); 
u  = ((Δt (σ^2))/2) - (Sqrt[Δ])t σ + 1; 
d  =  
          1/u; 
p  = 
          (1/2) +  (((Sqrt[Δ])t ((σ^2) - 2 r))/(4 σ)); 
q  =  
          1 - p; 
δ  =  (E^(-r Δt)); 
VT  =  
          Map[Call[#, X, σ, Δt, r] &, 
            Table[S (d^j) (u^((n - 1) - j)), {j, 0, 
                n - 1}]]; 
 
        Nest[ListConvolve[δ {q, p}, #] &, VT, n - 1] //  
          First
]

This adjustment works also for the valuation of american options, since the american and european options are not distinguishable (in a tree sense) one step before maturity.

Now looking at the timing it can be seen that this improvement slows down the tree considerable.

ImprovCRRBinomial[(Subscript[S, 0]), X, σ, τ, r, 200]  //  
      Timing

To speed things up we use a compiled version for the Black-Scholes formula, which cuts the calculation time into half. But it is still considerable higher then the first version.

Norm = Compile[{x}, (1 + Erf[x/Sqrt[2]])/2];
Call = 
        Compile[{S, X, sigma, T, r}, 
          Module[{d1, d2}, 
            d1 = (Log[S/X] + (r + sigma^2/2)*T)/(sigma*
                    Sqrt[T]);  d2 = d1 - sigma*Sqrt[T];  
            S*Norm[d1] - (X*Norm[d2]) E^(-r*T)]];
ImprovCRRBinomial[(Subscript[S, 0]), X, σ, τ, r, 200]  //  
      Timing

But looking at the same graphic it can be seen that the improvement in accuarcy is quite impressive (All graphics have the same plot range).

data  =  
        Table[{n, ImprovCRRBinomial[(Subscript[S, 0]), X, σ, τ, r, n]}, {n, 
            50, 250}]; 
ListPlot[data, PlotJoined -> True, AspectRatio -> 0.5, 
        PlotRange -> {1.6, 1.63}, 
        Epilog -> {Red, Line[{{50, bs}, {250, bs}}]}];

References

Cox, J., Ross, S., Rubenstein, M., 1979, Option Pricing: A Simplified Approach, in: Journal of Financial Economics 7, p. 229-263.

Omberg, E., 1987, A Note on the Convergence of Binomial-Pricing and Combound-Option Models, in: Journal of Finance 42, p. 463-469.

Shaw, W., 1998, Modelling Financial Derivatives with Mathematica, Cambridge University Press.