/*
** 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 
**
**   Calculating a short term interest rate lattice using the 
**   Black-Derman-Toy Model.                                  
**
*/

new ;  cls ;

/*
ofile = "c:\\kcdn\\output.out" ;
output file = ^ofile reset ;
*/

format /m1/rdn 16,8 ;  output on ; screen on ;
" ------------------------------------------------------------------------ " ;
"                                                                          " ; 
"   FILE : Chp18 Tab2 Int rate lattice.txt                                 " ;
"   ======================================                                 " ;
"                                                                          " ; 
" Version  20/07/2001                                                      " ; 
"                                                                          " ; 
" Copyright K.Cuthbertson and D. Nitzsche                                  " ; 
" 'Financial Engineering:Derivatives and Risk Manangement' - J. Wiley 2001 " ; 
"                                                                          " ; 
"  PRICING INTEREST ARTE DERIVATIVES                                       " ; 
"  Calculating a short term interest rate lattice using the                " ; 
"  Black-Derman-Toy Model                                                  " ;
"                                                                          " ;
" ------------------------------------------------------------------------ " ;
output off ; screen off ; 

" ---------------------------------------------------------- " ;
"                                                            " ; 
"            Definitions of Variables Used                   " ;
"            -----------------------------                   " ;
"                                                            " ;
"   T                  = Time horizon                        " ;    
"   dt                 = delta t                             " ;    
"   Prob_u             = Probability of up                   " ;    
"   FV                 = Face value 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      = 1 ;

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 ;

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 (requires to call the procedures)
** ------------------------------------------------------------
*/

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 ;
      " ========================================================== " ;
?; " Time period    ";       T_print' ;
?; " Interest rates " ;      r_print' ;
?; " Volatility     " ;      sigma_print' ;

{irll,TT} = print_fmt(irll) ;                           @ This procedure fills in dots at the upper triangle @

?;?; " Interest Rate Lattice " ;
     " --------------------- " ;
        print irll ; 
     ?; print TT ;
 
     
/* ------------------------------------------------------------------------ 
        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 ;