/* ** 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 a European call option on a coupon paying bond ** using the BDT model. ** The calculations are done in the procedure below. ** */ new ; cls ; /* ofile = "c:\\kcdn\\output.out" ; output file = ^ofile reset ; */ format /m1/rdn 16,8 ; output on ; screen on ; " ------------------------------------------------------------------------ " ; " " ; " FILE : Chp18 Tab4 European 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 a European 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 forward rate 1 and 2 @ sigma[3,1] = 0.19 ; @ Volatility of forward rate 2 and 3 @ sigma[4,1] = 0.18 ; @ Volatility of forward rate 3 and 4 @ sigma[5,1] = 0.17 ; @ Volatility of forward rate 4 and 5 @ @ ----------------------------------------- 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 ; ?; "Time and Volatility" TTime~sigma ; ?; "Spot Rates and Bond Prices for different maturities" r~Price ; 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 Matrix " ; " ----------------- " ; {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 ----- @ ?;?; " European Call Premium Matrix " ; " ---------------------------- " ; {Euro_Call} = E_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] as BondP matrix has one more row than interest 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 European Option) ** requires to run BondP procedure before. ** also runs print_ftm procedure ** ** PROCEDURES (used within PROC) : print_ftm ** ** OUTPUT : Euro_Call (Call premium for European style option) ** ** GLOBALS : FV (Face value of bond) ** --------------------------------------------------------------- */ proc(1) = E_Call(BondP, Strike, irll, Prob_u, dt) ; local ro, co, Euro_Call, Int_VC, EC_lc, i, j, k ; 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 ; Euro_Call = zeros(ro-1,co-2) ; Int_VC = BondP[2:ro,co-1] - Strike ; EC_lc = Int_VC .ge 0 ; EC_lc = Int_VC.*EC_lc ; Euro_Call = Euro_Call~EC_lc ; i = co-2 ; k = 0 ; do until i < 1 ; j = ro - 1 ; do until j < 2 + k ; Euro_Call[j,i] = (Prob_u*Euro_Call[j-1,i+1] + (1-Prob_u)*Euro_Call[j,i+1])/(1+irll[j,i])^dt ; @ -- Note : discounted here by irll[j,i] as Euro_Call matrix same size as interest rate matrix-- @ j = j - 1 ; endo ; k = k + 1 ; i = i - 1 ; endo ; {Euro_Call,TT} = print_fmt(Euro_Call) ; print Euro_Call ; ?; print TT ; retp(Euro_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 ;