diff options
| -rw-r--r-- | build_SC.R | 161 | ||||
| -rw-r--r-- | cds_functions_generic.R | 38 | ||||
| -rw-r--r-- | cds_utils.R | 2 |
3 files changed, 82 insertions, 119 deletions
@@ -145,7 +145,7 @@ maturity <- function(creditcurve){ }
}
-stackcurve <- function(SC, line.item, startdate, global.params){
+stackcurve <- function(SC, line.item, global.params, startdate){
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
@@ -160,17 +160,20 @@ stackcurve <- function(SC, line.item, startdate, global.params){ 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
+buildSC.matured <- function(SC, line.item, reinvdate, dealmaturity, global.params, startdate){
+ if(startdate<=reinvdate){ #reinvest
+ line.item$maturity <- min(dealdata$maturity, startdate + global.params$rollingmaturity)
+ SC <- stackcurve(SC, line.item, global.params,)
+ }else{ #no reinvestment
+ SC@dates <- startdate
+ SC@hazardrates <- 0
+ SC@prepayrates <- 0
}
+ return( SC )
+}
+
+buildSC <- function(line.item, reinvdate, dealmaturity, global.params, startdate){
+ ## cat(line.item$issuername, "\n")
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)
@@ -178,55 +181,46 @@ buildSC <- function(line.item, global.params, startdate=today()){ 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){
+ if(!is.na(line.item$defaultedflag) && line.item$defaultedflag){
+ if(!is.na(line.item$price)){
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
- }
- }
+ line.item$currentbalance <- line.item$currentbalance * recovery(line.item)
+ }
+ SC@startdate <- startdate + global.params$defaultedlag
+ line.item$maturity <- min(dealdata$maturity, SC@startdate + global.params$rollingmaturity)
+ ## automatic reinvest
+ SC<- stackcurve(SC, line.item, global.params, SC@startdate)
+ }else if(line.item$maturity<=startdate){#matured asset
+ SC <- buildSC.matured(SC, line.item, reinvdate, dealmaturity, global.params, startdate)
+ }else if(is.na(line.item$price)){ #missing price
+ SC <- stackcurve(SC, line.item, global.params, SC@startdate)
+ }else{ #normal case
+ if(line.item$assettype=="Bond"){ #no prepay rate
+ alpha <- 0
+ }else{
+ alpha <- global.params$alpha
}
- ## if(length(maturity(SC))==0){
- ## browser()
- ## }
- if(maturity(SC) <= dealdata$"Reinv End Date"){ #we reinvest
+ try <- bondhazardrate.shaped(line.item, global.params$shape,
+ recovery(line.item), alpha)
+ if(is.null(try)){
+ SC <- stackcurve(SC, line.item, global.params, SC@startdate)
+ }else{
+ SC <- try
+ }
+ }
+ if(maturity(SC) <= reinvdate){ #we reinvest
newstartdate <- line.item$maturity
line.item$maturity <- min(dealdata$maturity, newstartdate + global.params$rollingmaturity)
- SC <- stackcurve(SC, line.item, newstartdate, global.params)
+ SC <- stackcurve(SC, line.item, global.params, newstartdate)
}
+ return( list(SC=SC, notional=line.item$currentbalance) )
}
buildSC.portfolio <- function(dealname, global.params, startdate=today()) {
@@ -238,77 +232,16 @@ buildSC.portfolio <- function(dealname, global.params, startdate=today()) { 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
+ ##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)
+ temp <- buildSC(line.item, dealdata$"Reinv End Date", dealdata$maturity, global.params, startdate)
+ notionalvec <- c(notionalvec, temp$notional)
+ SCvec <- c(SCvec, temp$SC)
betavec <- c(betavec, if(!is.na(line.item$iscdo) && line.item$iscdo) 1 else
global.params$defaultcorr)
}
diff --git a/cds_functions_generic.R b/cds_functions_generic.R index d3f980a5..45482212 100644 --- a/cds_functions_generic.R +++ b/cds_functions_generic.R @@ -556,11 +556,11 @@ survivalProbability.exact <- function(credit.curve, date) { return( exp(as.numeric(logprob)) )
}
-PD <- function(sc){
- ## computes the default probability associated with the survival curve
+SP <- function(sc){
+ ## computes the survival probability associated with the survival curve
T <- c(0, yearFrac(today(), sc@dates))
dT <- diff(T)
- return( 1-cumprod(exp(-sc@hazardrates * dT)) )
+ return( cumprod(exp(-sc@hazardrates * dT)) )
}
@@ -568,7 +568,37 @@ SPmatrix <- function(portfolio, index){ cs <- couponSchedule(nextIMMDate(today()), index$maturity, "Q", "FIXED", index$coupon)
SP <- matrix(0, length(portfolio), length(cs$dates))
for(i in 1:length(portfolio)){
- SP[i,] <- 1 - PD(portfolio[[i]]@curve)[1:length(cs$dates)]
+ SP[i,] <- PD(portfolio[[i]]@curve)[1:length(cs$dates)]
}
return( SP )
}
+
+DP2 <- function(sc){
+ ## computes the default probability and prepay probability associated
+ ## with the survival curve
+ T <- c(0, yearFrac(today(), sc@dates))
+ dT <- diff(T)
+ Q <- cumprod(exp(- (sc@hazardrates[1:length(dT)]+sc@prepayrates[1:length(dT)]) * dT))
+ Qmid <- 1/2 * (c(1, Q[-length(Q)]) + Q)
+ list(dates=T[-1],
+ defaultprob= cumsum(sc@hazardrates[1:length(dT)] * Qmid * dT),
+ prepayprob = cumsum(sc@prepayrates[1:length(dT)] * Qmid * dT))
+}
+
+SPmatrix2 <- function(portfolio, dealdata){
+ ## computes the default probability and prepay matrix of a portfolio
+ ## at the dates specified from dealdata
+ dates <- seq(dealdata$"Deal Next Pay Date", dealdata$maturity, by="3 months")
+ T <- yearFrac(today(), dates)
+ DP <- matrix(0, length(portfolio), length(dates))
+ PP <- matrix(0, length(portfolio), length(dates))
+ for(i in 1:length(portfolio)){
+ temp <- DP2(portfolio[[i]]@curve)
+ ## linear interpolation of the default and prepay prob
+ ## need to figure out a better way to do this
+ DP[i,] <- approxfun(temp$dates, temp$defaultprob, rule=2)(T)
+ PP[i,] <- approxfun(temp$dates, temp$prepayprob, rule=2)(T)
+ }
+ return(list(DP, PP))
+}
+
diff --git a/cds_utils.R b/cds_utils.R index 84485965..f9e6be03 100644 --- a/cds_utils.R +++ b/cds_utils.R @@ -76,7 +76,7 @@ couponSchedule <- function(nextpaydate=NULL, maturity, frequency, coupontype, cu }else{
dates <- seq(nextpaydate, maturity, by = bystring)
}
- if(dates[length(dates)<maturity){
+ if(dates[length(dates)]<maturity){
dates <- c(dates, maturity)
}
dates <- dates[ dates >= today()]
|