path: root/build_SC.R

library(RQuantLib)
library(statmod)
root = "//WDSENTINEL/share/CorpCDOs/R"
setwd(root)
source(file.path(root, "yieldCurve.R"))
source(file.path(root, "cds_functions_generic.R"))
source(file.path(root, "etdb.R"))
load(file.path(root, "bloomberg_data.RData"))
MarkitData <- getMarkitIRData()
L1m <- buildMarkitYC(MarkitData, dt = 1/12)
L2m <- buildMarkitYC(MarkitData, dt = 1/6)
L3m <-  buildMarkitYC(MarkitData)
L6m <- buildMarkitYC(MarkitData, dt = 1/2)
setEvaluationDate(as.Date(MarkitData$effectiveasof))


bps <- 1e-4
global.params <- list()
global.params$recovery.assumptions <- list("Loan"=0.7,
                                           "SecondLien"=0.3,
                                           "Bond"=0.3,
                                           "Mezzanine"=0.15,
                                           "Adj_Covlite"=0.1)

global.params$cdoprices <- list("Aaa"=90,
                                "Aa"=80,
                                "A"=70,
                                "Baa"=60,
                                "Ba"=50,
                                "B"=40,
                                "NR"=40)
#reinvest in 7 years assets
global.params$rollingmaturity <- 7 * 365
global.params$defaultedlag <- 90
global.params$defaultcorr <- 0.4
global.params$defaultbondhazardrate <- 500 * bps
global.params$defaultloanhazardrate <- 400 * bps
global.params$alpha <- 0.25
global.params$beta <- 15
global.params$shape <- function(T)0.25+(1-exp(-T/5))

cdorating <- function(cusip){
    return( sub("[0-9]","", dataMtge[dataMtge$CUSIP %in% cusip,]$RTG_MDY_INITIAL ))
}

getcollateral <- function(dealname, date=Sys.Date()){
    sqlstring <- sprintf("select * from et_aggdealinfo_historical('%s', '%s')", dealname, date)
    collatdata <- dbGetQuery(dbCon, sqlstring)
    return(collatdata)
}

getdealdata <- function(dealname, date=Sys.Date()){
    sqlstring <- sprintf("select * from clo_universe where dealname='%s' order by \"Latest Update\"", dealname)
    return( dbGetQuery(dbCon, sqlstring)[1,] )
}

recovery <- function(collateral) {
    ## return assumed recovery based on assumptions from recovery.assumptions
    if(!is.na(collateral$secondlien) && collateral$secondlien){
        collateral$assettype <- "SecondLien"
    }
    recovery <- with(global.params,
                     as.numeric(recovery.assumptions[collateral$assettype]))
    if( !is.na(collateral$covlite) && collateral$covlite) {
        recovery <- recovery - global.params$recovery.assumptions$Adj_Covlite
    }
    if( !is.na(collateral$iscdo) && collateral$iscdo ){
        recovery <- 0
    }
    ## price is too low need to lower the assumed recovery
    if(!is.na(collateral$price) && recovery > collateral$price/100 - 0.1){
        recovery <- max(collateral$price/100-0.2, 0)
    }
    return(recovery)
}

dealnamefromcusip <- function(cusips){
    ## wrapper around the sql procedure, not the fastest probably
    r <- NULL
    for(i in 1:length(cusips)){
        sqlstr <- sprintf("select * from dealname_from_cusip('%s')", cusips[i])
        r <- c(r, as.character(dbGetQuery(dbCon, sqlstr)))
    }
    return( r )
}

fithazardrate.fast <- function(collateral, eps=1e-6){
    lambda <- 0.05
    cs <- couponSchedule(collateral$nextpaydate, collateral$maturity,
                         collateral$frequency, collateral$fixedorfloat,
                         collateral$grosscoupon * 0.01, collateral$spread*0.01)
    R <- recovery(collateral)
    while(abs(bondprice(lambda, cs, R) * 100 - collateral$price) > eps){
        lambda <- lambda - (bondprice(lambda, cs, R) - 0.01*collateral$price)/dbondprice(lambda, cs, R)
    }
    return( lambda )
}

vanillabondprice <- function(h, collateral, prepay=TRUE) {
    R <- recovery(collateral)
    cs <- couponSchedule(collateral$nextpaydate, collateral$maturity,
                         collateral$frequency, collateral$fixedorfloat,
                         collateral$grosscoupon*0.01, collateral$spread*0.01)
    if(prepay){
        dpc <- new("defaultprepaycurve", dates=cs$dates, hazardrates=rep(h,length(cs$dates)),
                   prepayrates=rep(k(h), length(cs$dates)))
    }else{
        dpc <- new("defaultprepaycurve", dates=cs$dates, hazardrates=rep(h,length(cs$dates)),
                   prepayrates=numeric(0))
    }
    return( bondprice(cs, dpc, R) )
}

dvanillabondprice <- function(hazardrate, collateral) {
    R <- recovery(collateral)
    cs <- couponSchedule(collateral$nextpaydate, collateral$maturity,
                         collateral$frequency, collateral$fixedorfloat,
                         collateral$grosscoupon*0.01, collateral$spread*0.01)
    return( bondprice(hazardrate, cs, R) )
}

fithazardrate <- function(collateral){
    R <- recovery(collateral)
    cs <- couponSchedule(collateral$nextpaydate, collateral$maturity,
                         collateral$frequency, collateral$fixedorfloat,
                         collateral$grosscoupon*0.01, collateral$spread*0.01)
    f <- function(lambda){
        u <- bondprice(lambda, cs, R )
        return( (u * 100-collateral$price)^2 )
    }
    return( optimize(f, c(0,1), tol=1e-6)$minimum )
}


maturity <- function(creditcurve){
    if(class(creditcurve)=="creditcurve"){
        dates <- creditcurve@curve@dates
        if(length(dates)){
            return( dates[length(dates)] )
        }else{
            return( creditcurve@startdate )
        }
    }else{
        stop("not of class creditcurve")
    }
}

stackcurve <- function(SC, line.item, startdate, global.params){
    newdates <- seq(startdate, line.item$maturity, by="3 months")
    if(line.item$assettype=="Loan"){
        hvec <- global.params$shape(yearFrac(today(), newdates[-1])) * global.params$defaultloanhazardrate
        kvec <- global.params$alpha * exp(-global.params$beta * hvec)
    }else if(line.item$assettype=="Bond" || line.item$iscdo){
        hvec <- global.params$shape(yearFrac(today(), newdates[-1])) * global.params$defaultbondhazardrate
        kvec <- rep(0, length(hvec))
    }
    SC@curve@hazardrates <- c(SC@curve@hazardrates, hvec)
    SC@curve@prepayrates <- c(SC@curve@prepayrates, kvec)
    SC@curve@dates <- c(SC@curve@dates, newdates[-1])
    return(SC)
}

buildSC <- function(line.item, global.params, startdate=today()){
     ## cat(i, "\n")
    line.item <- collatdata[i,]
    ## cat(line.item$issuername, "\n")
    if( is.na(line.item$maturity) ){
        stop("empty maturity")
    }
    ##most likely equity, doesn't impact the risk anyway
    if(line.item$currentbalance < 1){
        next
    }
    if(!is.na(line.item$iscdo) && line.item$iscdo && is.na(line.item$price)){
        ##we have prices for some cdos e.g. 210795PS3
        orig.moody <- cdorating(line.item$cusip)
        if(length(orig.moody)==0){
            orig.moody <- "NR"
        }
        line.item$price <- as.numeric(global.params$cdoprices[orig.moody])
        }
    ##build survival curve
    SC <- new("creditcurve", recovery=recovery(line.item), startdate=startdate,
              issuer=line.item$issuername)
    SC@curve <- new("defaultprepaycurve", dates=as.Date(character(0)))
    ## defaulted asset
        if(!is.na(line.item$defaultedflag) && line.item$defaultedflag){
            line.item$currentbalance <- line.item$currentbalance * line.item$price/100
            SC@startdate <- startdate + global.params$defaultedlag
            line.item$maturity <- min(dealdata$maturity, SC@startdate + global.params$rollingmaturity)
            ## automatic reinvest
            SC<- stackcurve(SC, line.item, SC@startdate, global.params)
        }else if( is.na(line.item$price) ){ #missing price
            if(line.item$maturity <= startdate){
                if(startdate<=dealdata$"Reinv End Date"){ #reinvest
                    line.item$maturity <- min(dealdata$maturity, startdate + global.params$rollingmaturity)
                    SC <- stackcurve(SC, line.item, SC@startdate, global.params)
                }else{ #no reinvestment
                    SC@dates <- startdate
                    SC@hazardrates <- 0
                    SC@prepayrates <- 0
                }
                SC <- stackcurve(SC, line.item, SC@startdate, global.params)
            }else{
                SC <- stackcurve(SC, line.item, SC@startdate, global.params)
            }
        }else{
            ## normal case
            if(line.item$maturity > startdate){
                if(line.item$assettype=="Bond"){ #no prepay rate
                    alpha <- 0
                }else{
                    alpha <- global.params$alpha
                }
                try <- bondhazardrate.shaped(line.item, global.params$shape,
                                             recovery(line.item), alpha)
                if(!is.null(try)){
                    SC@curve <- try
                }
            }
        }
    ## if(length(maturity(SC))==0){
    ##     browser()
    ## }
    if(maturity(SC) <= dealdata$"Reinv End Date"){ #we reinvest
        newstartdate <- line.item$maturity
        line.item$maturity <- min(dealdata$maturity, newstartdate + global.params$rollingmaturity)
        SC <- stackcurve(SC, line.item, newstartdate, global.params)
    }
}

buildSC.portfolio <- function(dealname, global.params, startdate=today()) {
    dealdata <- getdealdata(dealname)
    collatdata <- getcollateral(dealname)
    notionalvec <- c()
    SCvec <- c()
    betavec <- c()
    for(i in 1:nrow(collatdata)){
        ## cat(i, "\n")
        line.item <- collatdata[i,]
        ## cat(line.item$issuername, "\n")
        if( is.na(line.item$maturity) ){
            stop("empty maturity")
        }
        #most likely equity, doesn't impact the risk anyway
        if(line.item$currentbalance < 1){
            next
        }
        if(!is.na(line.item$iscdo) && line.item$iscdo && is.na(line.item$price)){
            #we have prices for some cdos e.g. 210795PS3
            orig.moody <- cdorating(line.item$cusip)
            if(length(orig.moody)==0){
                orig.moody <- "NR"
            }
            line.item$price <- as.numeric(global.params$cdoprices[orig.moody])
        }
        #build survival curve
        SC <- new("creditcurve", recovery=recovery(line.item), startdate=startdate,
                  issuer=line.item$issuername)
        SC@curve <- new("defaultprepaycurve", dates=as.Date(character(0)))
        ##expired asset
        ## if(i ==185){
        ##     browser()
        ## }
        ## defaulted asset
        if(!is.na(line.item$defaultedflag) && line.item$defaultedflag){
            line.item$currentbalance <- line.item$currentbalance * line.item$price/100
            SC@startdate <- startdate + global.params$defaultedlag
            line.item$maturity <- min(dealdata$maturity, SC@startdate + global.params$rollingmaturity)
            ## automatic reinvest
            SC<- stackcurve(SC, line.item, SC@startdate, global.params)
        }else if( is.na(line.item$price) ){ #missing price
            if(line.item$maturity <= startdate){
                if(startdate<=dealdata$"Reinv End Date"){ #reinvest
                    line.item$maturity <- min(dealdata$maturity, startdate + global.params$rollingmaturity)
                    SC <- stackcurve(SC, line.item, SC@startdate, global.params)
                }else{ #no reinvestment
                    SC@dates <- startdate
                    SC@hazardrates <- 0
                    SC@prepayrates <- 0
                }
                SC <- stackcurve(SC, line.item, SC@startdate, global.params)
            }else{
                SC <- stackcurve(SC, line.item, SC@startdate, global.params)
            }
        }else{
            ## normal case
            if(line.item$maturity > startdate){
                if(line.item$assettype=="Bond"){ #no prepay rate
                    alpha <- 0
                }else{
                    alpha <- global.params$alpha
                }
                try <- bondhazardrate.shaped(line.item, global.params$shape,
                                             recovery(line.item), alpha)
                if(!is.null(try)){
                    SC@curve <- try
                }
            }
        }
        ## if(length(maturity(SC))==0){
        ##     browser()
        ## }
        if(maturity(SC) <= dealdata$"Reinv End Date"){ #we reinvest
            newstartdate <- line.item$maturity
            line.item$maturity <- min(dealdata$maturity, newstartdate + global.params$rollingmaturity)
            SC <- stackcurve(SC, line.item, newstartdate, global.params)
        }

        notionalvec <- c(notionalvec, line.item$currentbalance)
        SCvec <- c(SCvec, SC)
        betavec <- c(betavec, if(!is.na(line.item$iscdo) && line.item$iscdo) 1 else
                     global.params$defaultcorr)
    }
    return( list(notional=notionalvec, SC=SCvec, beta=betavec) )
}

## duration <- function(creditcurve){
##     # computes the duration for a hazard rate curve
##     T <- yearFrac(creditcurve@startdate, creditcurve@curve@dates)
##     r <- DiscountCurve(L3m$params, L3m$tsQuotes, T)$forwards
##     h <- creditcurve@curve@hazardrates
##     if(class(creditcurve)=="creditcurve"){
##         T.ext <- c(0, T)
##         s <- (exp(- (h + r) * T.ext[-1]) - exp(- (h + r)* T.ext[-length(T.ext)]))/(h+r)
##     }else{
##         stop("not of class credit curve")
##     }
##     return( - sum(s) )
## }


## dealnames <- c("babs072", "symph4", "flags5", "cent11", "wasatl", "oceant2", "acacl071", "limes")

## for(dealname in dealnames){
##     cat(dealname,"\n")
##     collatdata <- dbGetQuery(dbCon,
##                              paste("select * from et_aggdealinfo_historical(", dealname, ",",
##                                    Sys.Date(),")",
##                                    sep="'"))
##     dealdata <- dbGetQuery(dbCon,
##                            paste("select maturity, \"Reinv End Date\" from clo_universe where dealname='", dealname, "'",sep=""))
##     portfolio <- buildSC.portfolio(today(), collatdata, dealdata)
## }

## dealname <- "symph4"
## maturity18 <- as.Date("2017-06-20")
## probs <- as.numeric(lapply(portfolio$SC, survivalProbability2, maturity18))
## weights <- portfolio$notional/sum(portfolio$notional)
## S <- weights * (1-as.numeric(lapply(portfolio$SC, attr, "recovery")))
## L.ind <- lossdistrib3(1-probs, S, 0.01)
## EL <- crossprod(seq(0,1,0.01), L.ind)

## library(statmod)
## n.int <- 500
## Z <- gauss.quad.prob(n.int, "normal")$nodes
## w <- gauss.quad.prob(n.int, "normal")$weights
## rho <- 0.35

## g <- 1 - probs
## R <- as.numeric(lapply(portfolio$SC, attr, "recovery"))
## r <- matrix(0, 101, 11)
## rho <- seq(0,1,0.1)
## rho[11] <- 0.999
## for(j in 1:11){
##     Lrho <- matrix(0,101,500)
##     for(i in 1:length(Z)){
##         g.shocked <- shockprob(g, rho[j], Z[i])
##         R.shocked <- stochasticrecov.simple(R, 0, Z[i], rho[j], g)
##         Lrho[,i] <- lossdistrib3(g.shocked, (1-R.shocked) * weights, 0.01)
##     }
##     r[,j] <- Lrho%*%w
## }

## R.shocked <- matrix(0,267,n.int)
## for(i in 1:length(Z)){
##     R.shocked [,i] <- stochasticrecov.simple(R, 0, Z[i], rho[j], g)
## }


dpc <- new("defaultprepaycurve", dates=cs$dates, hazardrates=rep(0.05,length(cs$dates)),
           prepayrates=rep(0.01, length(cs$dates)))

dc <- new("defaultcurve", dates=cs$dates, hazardrates=rep(0.05,length(cs$dates)))

octagon8.collateral <- getcollateral("octagon8")
octagon8.dealdata <- getdealdata("octagon8")
pomme <- buildSC.portfolio(today(), octagon8.collateral, octagon8.dealdata)

collateral <- octagon8.collateral[1,]
cs <- couponSchedule(collateral$nextpaydate, collateral$maturity,
                     collateral$frequency, collateral$fixedorfloat,
                     collateral$grosscoupon*0.01, collateral$spread*0.01)

k <- function(h, gamma = 15){
    0.25*exp(-gamma * h)
}

test <- buildSC.portfolio("stonln1", global.params)