/* ** Version 01 ** Date : 20/07/2001 ** -------------------------------------------------------------------------- ** Copyright K.Cuthbertson and D. Nitzsche ** "Financial Engineering:Derivatives and Risk Manangement" - J. Wiley 2001 ** ** PRICING INTEREST RATE DERIVATIVES ** ** Pricing an American call option on a coupon paying bond using the BDT model. ** The calculations are being done in the procedure. ** */ new ; cls ; /* ofile = "c:\\kcdn\\output.out" ; output file = ^ofile reset ; */ format /m1/rdn 16,8 ; output on ; screen on ; " ------------------------------------------------------------------------ " ; " " ; " FILE : Chp18 Tab5 American call option.txt " ; " ========================================== " ; " " ; " Version 20/07/2001 " ; " " ; " Copyright K.Cuthbertson and D. Nitzsche " ; " 'Financial Engineering:Derivatives and Risk Manangement' - J. Wiley 2001 " ; " " ; " PRICING INTEREST RATE DERIVATIVES " ; " Pricing an American call option on a coupon paying bond using the " ; " BDT model. " ; " The calculations are done in the procedure below. " ; " " ; " ------------------------------------------------------------------------ " ; output off ; screen off ; " ---------------------------------------------------------- " ; " " ; " Definitions of Variables Used " ; " ----------------------------- " ; " " ; " T = Time horizon " ; " dt = delta t " ; " Prob_u = Probability of up " ; " FV = Face value of bond " ; " coupon = Coupon rate of bond " ; " Strike = Strike rate of bond " ; " " ; " r = spot rates (T x 1) vector " ; " sigma = volatilities of forward rates " ; " ---------------------------------------------------------- " ; @ --------------------------------------- START USER DATA INPUT ------------------------------- @ T = 5 ; dt = 1 ; Prob_u = 0.5 ; FV = 100 ; coupon = 0.10 ; Strike = 110 ; r = zeros(T,1) ; sigma = zeros(T,1) ; r[1,1] = 0.05 ; @ Spot rate : 1 period @ r[2,1] = 0.06 ; @ Spot rate : 2 period @ r[3,1] = 0.07 ; @ ... @ r[4,1] = 0.08 ; r[5,1] = 0.09 ; @ Note Volatility for 1 period spot is not used @ sigma[2,1] = 0.20 ; @ Volatility of f12 @ sigma[3,1] = 0.19 ; @ Volatility of f23 @ sigma[4,1] = 0.18 ; @ Volatility of f34 @ sigma[5,1] = 0.17 ; @ Volatility of f45 @ @ ------------------------------------------- END USER DATA INPUT ----------------------------- @ r_print = r ; sigma_print = sigma ; T_print = seqa(0,1,T) ; TTime = seqa(1,1,T) ; Prob_d = 1-Prob_u ; one_r = ones(T,1) ; one_r = one_r + r ; disc = one_r^TTime ; FValue = 100*ones(T,1) ; FValue2 = FValue|FValue[1,1] ; Price = FValue./disc ; Price = Price/100 ; Price = 1|Price ; r = 0|r ; irl = zeros(T,T) ; d = zeros(T,T) ; Q = zeros(T,T) ; U = zeros(T,1) ; irl[1,1] = r[2,1] ; Q[1,1] = 1 ; U[1,1] = r[2,1] ; d[1,1] = 1/(1+r[2,1]*dt) ; i = 2 ; do until i > T ; @ Outer Loop [different time periods] @ jj = -(i-1) ; jj_v = zeros(i,1) ; k = 1 ; do until k > i ; jj_v[k,1] = jj ; @ Vector which contains the j's @ jj = jj + 2 ; k = k + 1 ; endo ; jj_v = rev(jj_v) ; Q[i,i] = prob_d*Q[i-1,i-1]*d[i-1,i-1] ; @ Building Q lattice - downs only @ Q[1,i] = prob_u*Q[1,i-1]*d[1,i-1] ; @ Building Q lattice - ups only @ if i > 2 ; @ Building Q lattice - middle bits @ j = 2 ; do until j > i-1 ; Q[j,i] = prob_u*Q[j-1,i-1]*d[j-1,i-1] + prob_d*Q[j,i-1]*d[j,i-1] ; j = j + 1 ; endo ; else ; endif ; {x1,f1,lagr,retcode} = sqpSolve(&fct,0.1) ; U[i,.] = X1 ; @ ------------------------- Procedure to solve for consistent one-period rates ---------------- @ proc fct(U) ; local p1, p2, sc ; p1 = Q[1:i,i].*(1/(1+U*exp(sigma[i,.]*jj_v[1:i,1].*sqrt(dt))*dt)) ; p2 = sumc(p1) - Price[i+1,.] ; sc = p2*p2 ; retp(sc) ; endp ; @ ------------------------------------------ End of Procedure --------------------------------- @ j = 1 ; do until j > i ; irl[j,i] = U[i,1]*exp(sigma[i,1]*jj_v[j,1]*sqrt(dt)) ; d[j,i] = 1/(1+irl[j,i]*dt) ; j = j+1 ; endo ; i = i + 1 ; endo ; irll = zeros(T,T) ; @ -------------------- Having upper diagonal filled with zeros --------------------- @ i = 1 ; do until i > T ; irll[T+1-i:T,i] = irl[1:i,i] ; i = i+1 ; endo ; @ -------------------------------------- PRINTING THE OUTPUT ------------------------------ @ output on ; screen on; ?; ?; " ========================================================== " ; " Parameters of the Model " ; " ========================================================== " ; " " ; " Time horizon (T) " T ; " delta t (dt) " dt ; " Probability of up move " Prob_u ; " Face value of bond " FV ; " Coupon rate of the bond (decimal) " coupon ; " Strike price of the coupon paying bond " Strike ; " ========================================================== " ; ?; " Time period "; print T_print' ; ?; " Interest rates " ; print r_print' ; ?; " Volatility " ; print sigma_print' ; {irll,TT} = print_fmt(irll) ; @ --- This procedure fills in dots at the upper triangular ---- @ ?;?; " Interest Rate Lattice " ; " --------------------- " ; print irll ; ?; print TT ; @ ---------- Note : The Program up to this point is the same as the program for Table 18.2 ---- @ @ ------------------------------- CALLING THE PROCEDURE : BOND PRICING ------------------------ @ ?;?; " Bond Price Lattice " ; " ------------------ " ; {BondP} = Bond_P(irll, FV, coupon, Prob_u, dt) ; @ -------- Note : The Program up to this point is the same as the program for Table 18.3 ------ @ ?;?; " American Call Premium Lattice " ; " ----------------------------- " ; {Am_Call} = A_Call(BondP, Strike, irll, Prob_u, dt) ; @ ----------------------------------------- END OF PROGRAM ------------------------------------ @ /* ** --------------------------------------------------------------- ** Procedure Procedure Procedure ** --------------------------------------------------------------- ** Calculating the Bond price (coupon paying bonds) ** for zero coupon bonds set coupon rate equal to 0. ** ** ** PROCEDURES (used within PROC) : print_ftm ** ** OUTPUT : BondP (Lattice of Bond Prices) ** --------------------------------------------------------------- */ proc(1) = Bond_P(irll, FV, c_rate, Prob_u, dt) ; local ro, co, coupon, BondP, BondPFV, i, j, k ; ro = rows(irll) ; co = cols(irll) ; coupon = FV*c_rate ; FV = FV + coupon ; BondP = zeros(ro+1,co) ; BondPFV = ones(ro+1,1)*FV ; BondP = BondP~BondPFV ; i = co ; k = 0 ; do until i < 1 ; j = ro + 1 ; do until j < 2 + k ; if i == 1 ; BondP[j,i] = (Prob_u*BondP[j-1,i+1] + (1-Prob_u)*BondP[j,i+1])/(1+irll[j-1,i])^dt ; else ; BondP[j,i] = ((Prob_u*BondP[j-1,i+1] + (1-Prob_u)*BondP[j,i+1])/(1+irll[j-1,i])^dt) + coupon ; endif ; @ -- Note: discounted here by irll[j-1,i]:BondP matrix has one more row than interest rate matrix --- @ j = j - 1 ; endo ; k = k + 1 ; i = i - 1 ; endo ; {BondP,TT} = print_fmt(BondP) ; print BondP ; ?; print TT ; retp(BondP) ; endp ; /* ** --------------------------------------------------------------- ** Procedure Procedure Procedure ** --------------------------------------------------------------- ** Calculating Call premium (for a American Option) ** requires to run BondP procedure before. ** also runs print_ftm procedure ** ** PROCEDURES (used within PROC) : print_ftm ** ** OUTPUT : Am_Call (Call premium for American style option) ** ** GLOBALS : FV (Face value of bond) ** --------------------------------------------------------------- */ proc(1) = A_Call(BondP, Strike, irll, Prob_u, dt) ; local ro, co, Am_Call, Int_VC, AC_lc, i, j, k, Val_u, Val_d, BPS ; ro = rows(BondP) ; co = cols(BondP) ; if BondP[1,co] == FV ; @ Note FV is a global here @ retp("Coupon Rate is 0 : Zero Coupon Bond here (EXIT OF PROCEDURE)") ; else ; Am_Call = zeros(ro-1,co-2) ; Int_VC = BondP[2:ro,co-1] - Strike ; AC_lc = Int_VC .ge 0 ; AC_lc = Int_VC.*AC_lc ; Am_Call = Am_Call~AC_lc ; BPS = BondP - Strike ; i = co-2 ; k = 0 ; do until i < 1 ; j = ro - 1 ; do until j < 2 + k ; if BPS[j,i+1] > Am_Call[j-1,i+1] ; Val_u = BPS[j,i+1] ; else ; Val_u = Am_Call[j-1,i+1] ; endif ; if BPS[j+1,i+1] > Am_Call[j,i+1] ; Val_d = BPS[j+1,i+1] ; else ; Val_d = Am_Call[j,i+1] ; endif ; /* ------------- Cell reference a bit confusing as Am_Call matrix is nxn -------------------- ------------- but BondP matrix is (n+1) x (n+1). -------------------- */ Am_Call[j,i] = (Prob_u*Val_u + (1-Prob_u)*Val_d)/(1+irll[j,i+1])^dt ; j = j - 1 ; endo ; k = k + 1 ; i = i - 1 ; endo ; {Am_Call,TT} = print_fmt(Am_Call) ; print Am_Call ; ?; print TT ; retp(Am_Call) ; endif ; endp ; /* ** --------------------------------------------------------------- ** Procedure Procedure Procedure ** --------------------------------------------------------------- ** Printing Format - general ** (to print dots in off diagonal elements). ** --------------------------------------------------------------- */ proc(2) = Print_fmt(mat) ; local ro, co, i, j, TT ; ro = rows(mat) ; co = cols(mat) ; TT = seqa(0,1,co) ; TT = TT' ; i = 1 ; do until i > co - 1 ; j = 1 ; do until j > ro - i ; mat[j,i] = miss(0,0) ; j = j + 1 ; endo ; i = i + 1 ; endo ; retp(mat,TT) ; endp ; end ;