R/mod_ir_curves.R

In lampoverde/Der: Derivatives and Structured Products

# TODO:
# Mettere curva spread
# Vedere altri interpolatori
# Implementare il Bootstrap


# Vecchie
discFix<-function(r){function(t) exp(-r*t)}
disc<-function(t,r){exp(-r*t)}


# ===============================================================================
# FUNZIONI CONDIVISE/CONDIVISIBILI
# ===============================================================================
df2zero<-function(df, t){-log(df)/t}
zero2df<-function(r,t){exp(-r*t)}
zero2fwd<-function(r1,r2,t1,t2){r2*t2/(t2-t1)-r1*t1/(t2-t1)}
df2fwd<-function(df1,df2, dt){log(df1/df2)/dt}
# mettere fwd istantanei



lin_interp<-function(tk, t, v){
  if(tk<=min(t)) v[1]
  else if (tk>=max(t)) v[length(v)]
  else{
    m<- max(which(t<=tk, arr.ind=TRUE))
    ((tk-t[m])*v[m+1] + (t[m+1]-tk)*v[m] ) / (t[m+1]-t[m])
  }
}

loglin_interp<-function(tk, t, v){
  logv<-log(v)
  if(tk<=min(t)) v[1]
  else if (tk>=max(t)) v[length(v)]
  else{
    m<- max(which(t<=tk, arr.ind=TRUE))
    dt<-(t[m+1]-t[m])
    (v[m+1]^((tk-t[m])/dt) * v[m]^((t[m+1]-tk)/dt) )
    
  }
}


# ===============================================================================
# TERM STRUCTURE CLASS (ASTRATTA)
# ===============================================================================
setClass(
  'yield_TS'
)

# create a method to assign the value of the location
setGeneric(name="get_r",def=function(obj,...){standardGeneric("get_r")})
setMethod(f="get_r", signature="yield_TS",
          definition=function(obj,t){return(df2zero(get_df(obj, t), t))}
)

setGeneric(name="get_df",def=function(obj,...){standardGeneric("get_df")})
setMethod(f="get_df", signature="yield_TS",
          definition=function(obj,t){return(zero2df(get_r(obj, t), t))}
)

setGeneric(name="get_fwd",def=function(obj,...){standardGeneric("get_fwd")})
setMethod(f="get_fwd", signature="yield_TS",
          definition=function(obj,t1,t2){
            d1<-get_df(obj, t1); d2<-get_df(obj, t2)
            return(df2fwd(d1,d2,t2-t1))
          }
)


# ===============================================================================
# TERM STRUCTURE CLASS FLAT (NON SERVE INTERPOLAZIONE)
# ===============================================================================
setClass(
  'zero_flat_yield_TS',
  representation(r = 'numeric'),
  prototype(r = NA_real_),
  validity = function(object){ifelse(length(object@r)==1,TRUE,'r must be scalar')},
  contains = 'yield_TS'
)


setMethod(f="get_r", signature="zero_flat_yield_TS",
          definition=function(obj,t){return(obj@r)}
)



# ===============================================================================
# ZERO TERM STRUCTURE CLASS
# ===============================================================================

setClass(
  'zero_yield_TS',
  representation(t = 'numeric', r = 'numeric', interp='function'),
  prototype(interp = lin_interp),
  validity = function(object){ifelse(length(object@r)==length(object@t), TRUE,
                                     't and r have different length')},
  contains = 'yield_TS'
) -> zero_yield_TS


setMethod(f='get_r', signature='zero_yield_TS',
          definition=function(obj,t,interpMethod=obj@interp){
            sapply(t, interpMethod, obj@t, obj@r)
          }
)

# ===============================================================================
# DISCOUNT TERM STRUCTURE CLASS
# ===============================================================================

setClass(
  'disc_yield_TS',
  representation(t = 'numeric', df = 'numeric', interp='function'),
  prototype(interp = loglin_interp),
  validity = function(object){ifelse(length(object@df)==length(object@t), TRUE,
                                     't and df have different length')},
  contains = 'yield_TS'
) -> disc_yield_TS


setMethod(f='get_df', signature='disc_yield_TS',
          definition=function(obj,t,interpMethod=obj@interp){
            sapply(t, interpMethod, obj@t, obj@df)
          }
)



# ===============================================================================
# SPREADED TERM STRUCTURE CLASS
# ===============================================================================

setClass(
  'spreaded_zero_yield_TS',
  representation(t = 'numeric', z = 'numeric', basecurve = 'yield_TS', interp='function'),
  prototype = c(t=NA_real_, z=NA_real_,basecurve=NULL, interp=lin_interp),
  validity = function(object){ifelse(length(object@z)==length(object@t), TRUE,
                                     't and z have different length')},
  contains = 'yield_TS'
) -> spreaded_zero_yield_TS



setMethod(f='get_r', signature='spreaded_zero_yield_TS',
          definition=function(obj,t,interpMethod=obj@interp){
            sapply(t, interpMethod, obj@t, obj@z) + 
              sapply(t, obj@basecurve@interp, obj@basecurve@t, get_r(obj@basecurve,obj@basecurve@t))
          }
)




# ===============================================================================
# BOOTSTRAP
# ===============================================================================


# RawData/Tipo Output/Interp->BootstrapFunction->disc/zero or fwd nodes-> obj disc/zero/fwd

depo<-data.frame(t=c(1/12,3/12,6/12), r=c(.001, .02, .03))
swap<-data.frame(t=c(1,2,5), r=c(.032, .038, .045))

bootstrap(depo=depo, swap=swap)

bootstrap<-function(depo=NULL, fra=NULL, fut=NULL, swap=NULL, interp){
 
  pv<-t<-array(NA, 0)
  
  for(j in 1:nrow(depo)){
    pv<-c(pv, depo2df(depo[j,]$r, depo[j,]$t)); t<-c(t, depo[j,]$t)          
  } 
  
  for(j in 1:nrow(fra)){
    pv1<-interpola(pv, isntr$t1)
    pv<-c(pv, fra2df(fra[j,]$r, fra[j,]$t1, fra[j,]$t2, pv1)); t<-c(r, fra[j,]$t2)          
  } 
  
  for(instr in fut){}
  
  tt<-seq(1,instr$t-1)
  pvi<-insterpola(pv, tt)

  for(j in 1:nrow(swap)){
    tt<-seq(1,instr$t-1)
    pvi<-insterpola(pv, tt)
    ri<- (1+instr$r)/(1-instr$r*sum(pvi))^(1/instr$t)-1
    pvi<- 1/((1+ri)^instr$t)
    pv<-c(pv, pvi); t<-c(t, instr$t)
    i<-i+1
  }
  
  list(df=pv, t=t)
  
}


depo2df<-function(r,t){1/(1+r*t)}
fra2df<-function(r,t1,t2,pv1){pv1/(1+r*(t2-t1))}
irfut2df<-function(v,t1,t2,pv){}