diff options
Diffstat (limited to 'R')
| -rw-r--r-- | R/cds_functions_generic.R | 154 | ||||
| -rw-r--r-- | R/cds_utils.R | 67 | ||||
| -rw-r--r-- | R/script_calibrate_tranches.R | 12 | ||||
| -rw-r--r-- | R/tranche_functions.R | 2 |
4 files changed, 122 insertions, 113 deletions
diff --git a/R/cds_functions_generic.R b/R/cds_functions_generic.R index eb851b2c..8ed227a0 100644 --- a/R/cds_functions_generic.R +++ b/R/cds_functions_generic.R @@ -27,9 +27,9 @@ setClass("defaultprepaycurve", representation(prepayrates="numeric"), contains=" setClass("creditcurve", representation(issuer="character", startdate="Date",
recovery="numeric", curve="defaultcurve"))
-shapedtodpc <- function(cs, sc){
+shapedtodpc <- function(cs, sc, startdate){
## convert a shaped curve to a standard defaultprepaycuve
- T <- yearFrac(Sys.Date(), cs$dates)
+ T <- yearFrac(startdate, cs$dates)
hvec <- sc@shape(T) * sc@h
kvec <- sc@alpha * exp(-sc@beta * hvec)
dpc <- new("defaultprepaycurve", hazardrates=hvec, prepayrates=kvec, dates=cs$dates)
@@ -43,7 +43,7 @@ setGeneric("couponleg", function(cs, sc, ...) { ## write couponleg methods for the four types of curves
setMethod("couponleg", signature("data.frame", "flatcurve"),
- function(cs, sc, startdate=Sys.Date(), accruedondefault=TRUE){
+ function(cs, sc, startdate=Sys.Date() + 1, accruedondefault=TRUE){
stopifnot(class(startdate)=="Date")
stopifnot(is.logical(accruedondefault))
T <- yearFrac(startdate, cs$dates)
@@ -59,11 +59,11 @@ setMethod("couponleg", signature("data.frame", "flatcurve"), setMethod("couponleg", signature("data.frame", "defaultcurve"),
## computes the pv of the risky coupon leg based on a given coupon schedule
## and a survival curve. Also called premium leg or fixed leg.
- function(cs, sc, startdate=Sys.Date(), accruedondefault=TRUE){
+ function(cs, sc, startdate=Sys.Date() + 1, accruedondefault=TRUE){
stopifnot(class(startdate)=="Date")
stopifnot(is.logical(accruedondefault))
- x1T <- yearFrac(Sys.Date(), sc@dates)
- x2T <- yearFrac(Sys.Date(), cs$dates)
+ x1T <- yearFrac(startdate, sc@dates)
+ x2T <- yearFrac(startdate, cs$dates)
dT <- diff(c(0, yearFrac(startdate, cs$dates)))
hfun <- approxfun(x1T, sc@hazardrates, method="constant", rule=2)
PD <- cumprod(exp(- hfun(x2T) * dT))
@@ -81,11 +81,11 @@ setMethod("couponleg", signature("data.frame", "defaultprepaycurve"), ## a hazard rate curve, and a prepay curve. We assume the poisson processes driving
## default and prepayment are independent, so the intensity of either event
## happenning is the sum of the two.
- function(cs, sc, startdate=Sys.Date(), accruedondefault=TRUE){
+ function(cs, sc, startdate=Sys.Date() + 1, accruedondefault=TRUE){
stopifnot(class(startdate)=="Date")
stopifnot(is.logical(accruedondefault))
- x1T <- yearFrac(Sys.Date(), sc@dates)
- x2T <- yearFrac(Sys.Date(), cs$dates)
+ x1T <- yearFrac(startdate, sc@dates)
+ x2T <- yearFrac(startdate, cs$dates)
dT <- diff(c(0, yearFrac(startdate, cs$dates)))
hfun <- approxfun(x1T, sc@hazardrates, method="constant", rule=2)
pfun <- approxfun(x1T, sc@prepayrates, method="constant", rule=2)
@@ -110,10 +110,10 @@ setMethod("couponleg", signature("data.frame", "shapedcurve"), ## a hazard rate curve, and a prepay curve. We assume the poisson processes driving
## default and prepayment are independent, so the intensity of either event
## happenning is the sum of the two.
- function(cs, sc, startdate=Sys.Date(), accruedondefault=TRUE){
+ function(cs, sc, startdate=Sys.Date() + 1, accruedondefault=TRUE){
stopifnot(class(startdate)=="Date")
stopifnot(is.logical(accruedondefault))
- return( couponleg(cs, shapedtodpc(cs, sc), startdate, accruedondefault) )
+ return( couponleg(cs, shapedtodpc(cs, sc, startdate), startdate, accruedondefault) )
})
## define dcouponleg generic
@@ -122,9 +122,9 @@ setGeneric("dcouponleg", function(cs, sc, index, ...) { })
setMethod("dcouponleg", signature("data.frame", "flatcurve", "missing"),
- function(cs, sc, accruedondefault=TRUE){
+ function(cs, sc, startdate=Sys.Date() + 1, accruedondefault=TRUE){
stopifnot(is.logical(accruedondefault))
- T <- yearFrac(Sys.Date(), cs$dates)
+ T <- yearFrac(startdate, cs$dates)
dPD <- -T * exp(- sc@h * T )
if(accruedondefault){
dPDadj <- 0.5 * (c(0, dPD[-length(dPD)]) + dPD)
@@ -136,9 +136,9 @@ setMethod("dcouponleg", signature("data.frame", "flatcurve", "missing"), setMethod("dcouponleg", signature("data.frame", "defaultcurve", "numeric"),
## derivative of couponleg with respect to hazardrate
- function(cs, sc, index, accruedondefault=TRUE) {
+ function(cs, sc, index, startdate=Sys.Date() + 1, accruedondefault=TRUE) {
stopifnot(is.logical(accruedondefault))
- dT <- diff(c(0, yearFrac(Sys.Date(), cs$dates)))
+ dT <- diff(c(0, yearFrac(startdate, cs$dates)))
PD <- cumprod(exp(-sc@hazardrates[1:length(dT)] * dT))
dPD <- -cumsum(index * dT) * PD
if(accruedondefault){
@@ -150,8 +150,8 @@ setMethod("dcouponleg", signature("data.frame", "defaultcurve", "numeric"), })
setMethod("dcouponleg", signature("data.frame", "shapedcurve", "missing"),
- function(cs, sc, accruedondefault = TRUE){
- T <- yearFrac(Sys.Date(), cs$dates)
+ function(cs, sc, startdate=Sys.Date() + 1, accruedondefault = TRUE){
+ T <- yearFrac(startdate, cs$dates)
dT <- diff(c(0, T))
hvec <- sc@h * sc@shape(T)
kvec <- sc@alpha*exp(-sc@beta*hvec)
@@ -189,10 +189,10 @@ setGeneric("cdsduration", function(sc, maturity, ...) { ## duration is based on the standard IMM schedule
setMethod("cdsduration", signature("abstractcurve", "Date"),
## computes the risky PV01, also called risky annuity of a cds
- function(sc, maturity, accruedondefault=TRUE){
+ function(sc, maturity, startdate=Sys.Date() + 1, accruedondefault=TRUE){
stopifnot(is.logical(accruedondefault))
- cs <- couponSchedule(nextIMMDate(Sys.Date()), maturity, "Q", "FIXED", 1)
- couponleg(cs, sc, accruedondefault=accruedondefault)
+ cs <- couponSchedule(IMMDate(startdate), maturity, "Q", "FIXED", 1)
+ couponleg(cs, sc, startdate, accruedondefault=accruedondefault)
})
## define defaultleg generic
@@ -204,8 +204,8 @@ setGeneric("defaultleg", function(cs, sc, recovery, ...) { setMethod("defaultleg", signature("data.frame", "flatcurve", "numeric"),
## Computes the pv of the default leg of a cds based on a given
## coupon schedule, flat hazard rate, and recovery.
- function(cs, sc, recovery){
- T <- yearFrac(Sys.Date(), cs$dates)
+ function(cs, sc, recovery, startdate=Sys.Date()+1){
+ T <- yearFrac(startdate, cs$dates)
dT <- diff(c(0, T))
Q <- exp(-sc@h * T) * cs$df
Qmid <- 1/2 * (c(1, Q[-length(Q)]) + Q)
@@ -216,8 +216,8 @@ setMethod("defaultleg", signature("data.frame", "flatcurve", "numeric"), setMethod("defaultleg", signature("data.frame", "defaultcurve", "numeric"),
## Computes the pv of the default leg of a cds based on a given
## coupon schedule, hazard rate curve, and recovery.
- function(cs, sc, recovery){
- T <- yearFrac(Sys.Date(), cs$dates)
+ function(cs, sc, recovery, startdate=Sys.Date()+1){
+ T <- yearFrac(startdate, cs$dates)
dT <- diff(c(0, T))
Q <- cumprod(exp(-sc@hazardrates[1:length(dT)] * dT)) * cs$df
Qmid <- 1/2 * (c(1, Q[-length(Q)]) + Q)
@@ -228,10 +228,10 @@ setMethod("defaultleg", signature("data.frame", "defaultcurve", "numeric"), setMethod("defaultleg", signature("data.frame", "defaultprepaycurve", "numeric"),
## Computes the pv of the default leg of a cds based on a given
## coupon schedule, hazard rates curve, prepay curves, and recovery.
- function(cs, sc, recovery, startdate=Sys.Date()){
+ function(cs, sc, recovery, startdate=Sys.Date()+1){
stopifnot(class(startdate)=="Date")
x2T <- yearFrac(startdate, cs$dates)
- x1T <- yearFrac(Sys.Date(), sc@dates)
+ x1T <- yearFrac(startdate, sc@dates)
dT <- diff(c(0, x2T))
hfun <- approxfun(x1T, sc@hazardrates, method = "constant", rule=2)
pfun <- approxfun(x1T, sc@prepayrates, method = "constant", rule=2)
@@ -243,19 +243,19 @@ setMethod("defaultleg", signature("data.frame", "defaultprepaycurve", "numeric") setMethod("defaultleg", signature("data.frame", "shapedcurve", "numeric"),
## Computes the pv of the default leg of a cds based on a shaped curve.
- function(cs, sc, recovery){
+ function(cs, sc, recovery, startdate=Sys.Date()+1){
return( defaultleg(cs, shapedtodpc(cs, sc), recovery) )
})
## define ddefaultleg generic
-setGeneric("ddefaultleg", function(cs, sc, recovery, index) {
+setGeneric("ddefaultleg", function(cs, sc, recovery, index, ...) {
standardGeneric("ddefaultleg")
})
setMethod("ddefaultleg", signature("data.frame", "flatcurve", "numeric", "missing"),
## derivative of defaultleg with respect to flat hazardrate
- function(cs, sc, recovery){
- T <- yearFrac(Sys.Date(), cs$dates)
+ function(cs, sc, recovery, startdate=Sys.Date()+1){
+ T <- yearFrac(startdate, cs$dates)
dT <- diff(c(0, T))
dQ <- - T * exp(-sc@h * T) * cs$df
Q <- exp(-sc@h * T) * cs$df
@@ -267,8 +267,8 @@ setMethod("ddefaultleg", signature("data.frame", "flatcurve", "numeric", "missin setMethod("ddefaultleg", signature("data.frame", "defaultcurve", "numeric", "numeric"),
## derivative of defaultleg with respect to hazardrate
- function(cs, sc, recovery, index){
- T <- yearFrac(Sys.Date(), cs$dates)
+ function(cs, sc, recovery, index, startdate=Sys.Date()+1){
+ T <- yearFrac(startdate, cs$dates)
dT <- diff(c(0,T))
Q <- cumprod(exp(-sc@hazardrates[1:length(dT)] * dT)) * cs$df
dQ <- - cumsum(index * dT) * Q
@@ -279,8 +279,8 @@ setMethod("ddefaultleg", signature("data.frame", "defaultcurve", "numeric", "num })
setMethod("ddefaultleg", signature("data.frame", "shapedcurve", "numeric", "missing"),
- function(cs, sc, recovery) {
- T <- yearFrac(Sys.Date(), cs$dates)
+ function(cs, sc, recovery, startdate=Sys.Date()+1) {
+ T <- yearFrac(startdate, cs$dates)
dT <- diff(c(0, T))
hvec <- sc@shape(T) * sc@h
kvec <- sc@alpha * exp(-sc@beta * hvec)
@@ -323,8 +323,8 @@ setMethod("contingentleg", signature("data.frame", "flatcurve", "numeric"), setMethod("contingentleg", signature("data.frame", "defaultcurve", "numeric"),
## Computes the pv of the contingent leg of a cds based on a given
## coupon schedule, flat hazard rate, and recovery.
- function(cs, sc, recovery){
- T <- yearFrac(Sys.Date(), cs$dates)
+ function(cs, sc, recovery, startdate=Sys.Date()){
+ T <- yearFrac(startdate, cs$dates)
dT <- diff(c(0, T))
Q <- cumprod(exp(-sc@hazardrates[1:length(dT)] * dT)) * cs$df
Qmid <- 1/2 * (c(1, Q[-length(Q)]) + Q)
@@ -337,8 +337,8 @@ setMethod("contingentleg", signature("data.frame", "defaultprepaycurve", "numeri ## coupon schedule, hazard rates curve, prepay curve, and recovery.
function(cs, sc, recovery, startdate=Sys.Date()) {
stopifnot(class(startdate)=="Date")
- x1T <- yearFrac(Sys.Date(), sc@dates)
- x2T <- yearFrac(Sys.Date(), cs$dates)
+ x1T <- yearFrac(startdate, sc@dates)
+ x2T <- yearFrac(startdate, cs$dates)
dT <- diff(c(0, yearFrac(startdate, cs$dates)))
hfun <- approxfun(x1T, sc@hazardrates, method="constant", rule=2)
pfun <- approxfun(x1T, sc@prepayrates, method="constant", rule=2)
@@ -350,20 +350,20 @@ setMethod("contingentleg", signature("data.frame", "defaultprepaycurve", "numeri })
setMethod("contingentleg", signature("data.frame", "shapedcurve", "numeric"),
- function(cs, sc, recovery, startdate=Sys.Date()){
+ function(cs, sc, recovery, startdate=Sys.Date()+1){
stopifnot(class(startdate)=="Date")
- return( contingentleg(cs, shapedtodpc(cs, sc), recovery, startdate) )
+ return( contingentleg(cs, shapedtodpc(cs, sc, startdate), recovery, startdate) )
})
## define dcontingentleg generic
-setGeneric("dcontingentleg", function(cs, sc, recovery, index) {
+setGeneric("dcontingentleg", function(cs, sc, recovery, index, ...) {
standardGeneric("dcontingentleg")
})
setMethod("dcontingentleg", signature("data.frame", "defaultcurve", "numeric", "numeric"),
## derivative of contingentleg with respect to hazardrate
- function(cs, sc, recovery, index){
- T <- yearFrac(Sys.Date(), cs$dates)
+ function(cs, sc, recovery, index, startdate=Sys.Date()){
+ T <- yearFrac(startdate, cs$dates)
dT <- diff(c(0,T))
Q <- cumprod(exp(-sc@hazardrates[1:length(dT)] * dT)) * cs$df
dQ <- - cumsum(index * dT) * Q
@@ -376,9 +376,9 @@ setMethod("dcontingentleg", signature("data.frame", "defaultcurve", "numeric", " setMethod("dcontingentleg", signature("data.frame", "defaultcurve", "numeric", "missing"),
## derivative of contingentleg with respect to hazardrate
- function(cs, sc, recovery){
+ function(cs, sc, recovery, startdate=Sys.Date()){
## derivative of contingentleg with respect to hazardrate
- T <- yearFrac(Sys.Date(), cs$dates)
+ T <- yearFrac(startdate, cs$dates)
dT <- diff(c(0, T))
Q <- exp(-sc@h * T) * cs$df
dQ <- -T * exp(- sc@h * T) * cs$df
@@ -391,8 +391,8 @@ setMethod("dcontingentleg", signature("data.frame", "defaultcurve", "numeric", " setMethod("dcontingentleg", signature("data.frame", "shapedcurve", "numeric", "missing"),
## Computes the pv of the contingent leg of a cds based on a given
## coupon schedule, hazard rates curve, prepay curve, and recovery.
- function(cs, sc, recovery){
- T <- yearFrac(Sys.Date(), cs$dates)
+ function(cs, sc, recovery, startdate=Sys.Date()){
+ T <- yearFrac(startdate, cs$dates)
dT <- diff(c(0, T))
hvec <- sc@shape(T) * sc@h
kvec <- sc@alpha * exp( - sc@beta *hvec)
@@ -406,27 +406,29 @@ setMethod("dcontingentleg", signature("data.frame", "shapedcurve", "numeric", "m return( as.numeric(dr) )
})
-cdspv <- function(cs, sc, recovery){
- return ( couponleg(cs, sc) - defaultleg(cs, sc, recovery))
+cdspv <- function(cs, sc, recovery, tradedate){
+ startdate <- tradedate + 1
+ return ( couponleg(cs, sc, startdate) - defaultleg(cs, sc, recovery, startdate))
}
cdsspread <- function(sc, maturity, recovery){
## computes exact cds running spread for a cds
## should be very close to hazardrate * (1-recovery)
- cs <- couponSchedule(nextIMMDate(Sys.Date()), maturity, "Q", "FIXED", 1)
+ cs <- couponSchedule(IMMDate(Sys.Date()), maturity, "Q", "FIXED", 1)
defaultleg(cs, sc, recovery)/couponleg(cs, sc)
}
-dcdspv <- function(cs, sc, recovery, index){
+dcdspv <- function(cs, sc, recovery, index, tradedate){
+ startdate <- tradedate + 1
if(missing(index)){
- return(dcouponleg(cs, sc)-ddefaultleg(cs, sc, recovery))
+ return(dcouponleg(cs, sc, startdate) - ddefaultleg(cs, sc, recovery, startdate))
}else{
- return ( dcouponleg(cs, sc, index) - ddefaultleg(cs, sc, recovery, index) )
+ return ( dcouponleg(cs, sc, index, startdate) - ddefaultleg(cs, sc, recovery, index, startdate) )
}
}
-bondpv <- function(cs, sc, recovery){
- return( contingentleg(cs, sc, recovery)+couponleg(cs, sc) )
+bondpv <- function(cs, sc, recovery, tradedate=Sys.Date()){
+ return( contingentleg(cs, sc, recovery) + couponleg(cs, sc) )
}
dbondpv <- function(cs, sc, recovery, index){
@@ -440,7 +442,7 @@ dbondpv <- function(cs, sc, recovery, index){ cdshazardrate.flat <- function(upfront, running, maturity, R=0.4){
## computes the implied hazard rate of the cds based on the upfront
## and running quotes, as well as maturity and recovery
- cs <- couponSchedule(nextIMMDate(Sys.Date()), maturity, "Q", "FIXED", running)
+ cs <- couponSchedule(IMMDate(Sys.Date()), maturity, "Q", "FIXED", running)
sc <- new("flatcurve", h = 0.05)
eps <- 1e-8
while(abs(cdspv(cs, sc, R) + upfront) > eps){
@@ -450,7 +452,7 @@ cdshazardrate.flat <- function(upfront, running, maturity, R=0.4){ }
cdshazardrate.shaped <- function(upfront, running, maturity, shape, R=0.4) {
- cs <- couponSchedule(nextIMMDate(Sys.Date()), maturity, "Q", "FIXED", running)
+ cs <- couponSchedule(IMMDate(Sys.Date()), maturity, "Q", "FIXED", running)
sc <- new("shapedcurve", shape=shape, h=0.05, alpha=0.25, beta=15)
eps <- 1e-8
while(abs(cdspv(cs, sc, R) + upfront) > eps){
@@ -459,10 +461,10 @@ cdshazardrate.shaped <- function(upfront, running, maturity, shape, R=0.4) { return(sc)
}
-cdshazardrate <- function(quotes, R=0.4, workdate=Sys.Date()){
+cdshazardrate <- function(quotes, R=0.4, tradedate=Sys.Date()){
## bootstrap the implied hazard rate curve of the cds based on the upfront
## and running quotes, as well as maturity and recovery
- previous.maturity <- workdate
+ previous.maturity <- tradedate
hvec <- c()
previous.hvec <- c()
eps <- 1e-8
@@ -472,14 +474,17 @@ cdshazardrate <- function(quotes, R=0.4, workdate=Sys.Date()){ next
}
maturity <- quotes$maturity[i]
- cs <- couponSchedule(nextIMMDate(workdate), maturity, "Q", "FIXED", quotes$running[i], workdate)
+ cs <- couponSchedule(IMMDate(tradedate), maturity, "Q", "FIXED", quotes$running[i],
+ tradedate, IMMDate(tradedate, "prev"))
new.h <- 0.05
flength <- nrow(cs) - nrow(previous.cs)
hvec <- c(previous.hvec, rep(new.h, flength))
sc <- new("defaultcurve", dates=cs$dates, hazardrates=hvec)
index <- c(rep(0, length(previous.hvec)), rep(1, flength))
- while(abs(cdspv(cs, sc, R) + quotes$upfront[i]) > eps){
- new.h <- new.h - (quotes$upfront[i] + cdspv(cs, sc, R))/dcdspv(cs, sc, R, index)
+ acc <- cdsAccrued(tradedate, quotes$running[i])
+ while(abs(cdspv(cs, sc, R, tradedate) + quotes$upfront[i]-acc) > eps){
+ new.h <- new.h - (quotes$upfront[i] + cdspv(cs, sc, R, tradedate) - acc)/
+ dcdspv(cs, sc, R, index, tradedate)
hvec <- c(previous.hvec, rep(new.h, flength))
sc@hazardrates <- hvec
}
@@ -538,15 +543,22 @@ tweakportfolio <- function(portfolio, epsilon, multiplicative=TRUE){ return( r )
}
-indexpv <- function(portfolio, index, epsilon=0, workdate=Sys.Date()){
- ## computes the intrinsic index pv of a portfolio of cds
- cs <- couponSchedule(nextIMMDate(workdate+1), index$maturity, "Q", "FIXED", index$coupon)
+indexpv <- function(portfolio, index, epsilon=0, tradedate=Sys.Date(), clean=TRUE){
+ ## computes the intrinsic price of a portfolio of cds
+ cs <- couponSchedule(IMMDate(tradedate), index$maturity, "Q", "FIXED", index$coupon, tradedate,
+ IMMDate(tradedate, "prev"))
if(epsilon!=0){
portfolio <- tweakportfolio(portfolio, epsilon)
}
- cl.list <- unlist(lapply(portfolio, function(x){couponleg(cs, x@curve)}))
- pl.list <- unlist(lapply(portfolio, function(x){defaultleg(cs, x@curve, x@recovery)}))
- return(list(cl = mean(cl.list), pl = mean(pl.list), bp = 1+mean(cl.list-pl.list)))
+ startdate <- tradedate + 1
+ cl.list <- unlist(lapply(portfolio, function(x){couponleg(cs, x@curve, startdate)}))
+ pl.list <- unlist(lapply(portfolio, function(x){defaultleg(cs, x@curve, x@recovery, startdate)}))
+ accrued <- cdsAccrued(tradedate, index$coupon)
+ r <- list(cl = mean(cl.list) - accrued, pl = mean(pl.list), bp = 1+mean(cl.list-pl.list))
+ if(clean){
+ r$bp <- r$bp-accrued
+ }
+ return(r)
}
indexduration <- function(portfolio, index){
@@ -598,11 +610,11 @@ portfolioduration <- function(portfolio, maturity){ return( crossprod(durations, portfolio$notional)/sum(portfolio$notional) )
}
-tweakcurves <- function(portfolio, index, workdate=Sys.Date()){
+tweakcurves <- function(portfolio, index, tradedate=Sys.Date()){
## computes the tweaking factor
epsilon <- 0
f <- function(epsilon, ...){
- abs(indexpv(portfolio, index, epsilon, workdate)$bp-index$indexref)
+ abs(indexpv(portfolio, index, epsilon, tradedate)$bp - index$indexref)
}
epsilon <- optimize(f, c(-0.5, 0.5), portfolio, index, tol=1e-6)$minimum
cat("tweak = ", epsilon, "\n")
@@ -670,7 +682,7 @@ SPmatrix <- function(portfolio, index){ ## matrix of survival probabilities of dimensions dim1 x dim2
## with dim1 number of issuers and dim2 number of dates in the
## coupon schedule of index
- cs <- couponSchedule(nextIMMDate(Sys.Date()), index$maturity, "Q", "FIXED", index$coupon)
+ cs <- couponSchedule(IMMDate(Sys.Date()), index$maturity, "Q", "FIXED", index$coupon)
SP <- matrix(0, length(portfolio), length(cs$dates))
for(i in 1:length(portfolio)){
SP[i,] <- SP(portfolio[[i]]@curve)[1:length(cs$dates)]
diff --git a/R/cds_utils.R b/R/cds_utils.R index a2f15b4e..5a3f83f8 100644 --- a/R/cds_utils.R +++ b/R/cds_utils.R @@ -47,32 +47,8 @@ addTenor <- function(date, tenor) { }
}
-creditSchedule <- function(startdate, enddate) {
- ## generate a credit coupon payment schedule from startdate
- ## to enddate based on the IMM dates
- month <- c(3, 6, 9, 12)
- day <- 20
- startmonth <- as.numeric(format(startdate, "%m"))
- startday <- as.numeric(format(startdate, "%d"))
- startyear <- as.numeric(format(startdate, "%Y"))
- if (startday > day){
- followingmonth <- which(month>startmonth)
- if (length(followingmonth)==0){
- startyear <- startyear+1
- startmonth <- 3
- }else{
- startmonth <- followingmonth[1]
- }
- }else{
- startmonth <- which(month>=startmonth)[1]
- }
- newdate <- as.Date(paste(startyear, month[startmonth], day, sep="-"))
- return(adjust(calendar="UnitedStates/GovernmentBond",
- seq(newdate, enddate, by="3 months")))
-}
-
couponSchedule <- function(nextpaydate=NULL, maturity, frequency, coupontype, currentcoupon,
- margin, startdate=Sys.Date()){
+ margin, tradedate=Sys.Date(), prevpaydate=tradedate){
## computes the coupon schedule
## inputs:
## nextpaydate: first payment date of the coupon schedule
@@ -89,7 +65,7 @@ couponSchedule <- function(nextpaydate=NULL, maturity, frequency, coupontype, cu stop("unknown frequency")
}
if(is.null(nextpaydate)){
- dates <- rev(seq(maturity, startdate, by =paste0("-", bystring)))
+ dates <- rev(seq(maturity, tradedate, by =paste0("-", bystring)))
}else{
if(nextpaydate>maturity){
dates <- maturity
@@ -105,7 +81,7 @@ couponSchedule <- function(nextpaydate=NULL, maturity, frequency, coupontype, cu dates <- c(dates, maturity)
}
}
- dates <- dates[ dates >= startdate]
+ dates <- dates[ dates >= tradedate]
dates <- adjust(calendar="UnitedStates/GovernmentBond", dates)
DC <- switch(frequency,
S = DiscountCurve(L6m$params, L6m$tsQuotes, yearFrac(L6m$params$tradeDate, dates)),
@@ -121,24 +97,45 @@ couponSchedule <- function(nextpaydate=NULL, maturity, frequency, coupontype, cu }else{
coupons <- rep(currentcoupon, length(dates))
}
- coupons <- diff(c(0, yearFrac(startdate, dates, "act/360"))) * coupons
- if(startdate!=DC$params$tradeDate){
- df <- cumprod(exp(-DC$forwards * diff(c(0, yearFrac(startdate, dates)))))
+ coupons <- diff(c(0, yearFrac(prevpaydate, dates, "act/360"))) * coupons
+ if(tradedate!=DC$params$tradeDate){
+ df <- cumprod(exp(-DC$forwards * diff(c(0, yearFrac(tradedate, dates)))))
}else{
df <- DC$discounts
}
return( data.frame(dates=dates, coupons=coupons, df = df) )
}
-nextIMMDate <- function(date) {
- startyear <- as.numeric(format(date, "%Y"))
- nextimmdates <- seq(as.Date(paste(startyear, 3, 20, sep="-")), length=5, by="3 months")
- val <- adjust(calendar = "UnitedStates/GovernmentBond",
- nextimmdates[nextimmdates >= date][1] )
+IMMDate <- function(tradedate, type="next") {
+ ## returns the next IMM date for a CDS, adjusted for settlement
+ ## or previous one if type="prev"
+ ## protection seems to be assumed at close of business day
+ ## so if we trade on Friday, we're protected during the week-end
+ ## matches with Bloomberg calculator
+ start.protection <- tradedate + 1
+ startyear <- as.numeric(format(start.protection, "%Y"))
+ if(as.numeric(format(tradedate, "%m")) <= 3){
+ startyear <- startyear - 1
+ }
+ nextimmdates <- seq(as.Date(paste(startyear, 3, 20, sep="-")), length=7, by="3 months")
+ if(type == "next"){
+ val <- adjust(calendar = "UnitedStates/GovernmentBond",
+ nextimmdates[nextimmdates >= start.protection][1] )
+ }else if(type == "prev"){
+ temp <- nextimmdates[nextimmdates < start.protection]
+ val <- adjust(calendar = "UnitedStates/GovernmentBond", temp[length(temp)] )
+ }else{
+ stop("incorrect type")
+ }
names(val) <- NULL
return( val )
}
+cdsAccrued <- function(tradedate, coupon){
+ start.protection <- tradedate + 1
+ return (yearFrac(IMMDate(tradedate, "prev"), start.protection, "act/360") * coupon)
+}
+
cdsMaturity <- function(tenor, date=Sys.Date()){
enddate <- addTenor(date, tenor)
month <- c(3, 6, 9, 12)
diff --git a/R/script_calibrate_tranches.R b/R/script_calibrate_tranches.R index ab29feca..10e8f470 100644 --- a/R/script_calibrate_tranches.R +++ b/R/script_calibrate_tranches.R @@ -63,20 +63,20 @@ issuerweights <- rep(1/length(hy21portfolio), length(hy21portfolio)) ## load tranche data
K <- c(0, 0.15, 0.25, 0.35, 1)
Kmodified <- adjust.attachments(K, hy21$loss, hy21$factor)
-markit.data <- read.csv(file.path(root.dir, "Scenarios", "Calibration",
+market.data <- read.csv(file.path(root.dir, "Scenarios", "Calibration",
paste0("hy21_tranches_", tradedate, ".csv")))
-tranche.upf <- markit.data$Mid
+tranche.upf <- market.data$Mid
tranche.running <- c(0.05, 0.05, 0.05, 0.05)
# get the index ref
-hy21$indexref <- markit.data$bidRefPrice[1]/100
+hy21$indexref <- market.data$bidRefPrice[1]/100
hy21portfolio.tweaked <- tweakcurves(hy21portfolio, hy21, tradedate)
SurvProb <- SPmatrix(hy21portfolio.tweaked, hy21)
Ngrid <- 2 * nrow(nondefaulted) + 1
recov <- sapply(hy21portfolio.tweaked, attr, "recovery")
-cs <- couponSchedule(nextIMMDate(tradedate), hy21$maturity,"Q", "FIXED", 0.05, 0)
-
+cs <- couponSchedule(IMMDate(tradedate), hy21$maturity,"Q", "FIXED", 0.05, 0, tradedate, IMMDate(tradedate, "prev"))
+acc <- cdsAccrued(tradedate, 0.05)
##calibrate by modifying the factor distribution
bottomup <- 1:3
topdown <- 2:4
@@ -107,7 +107,7 @@ for(l in 1:150){ R[,,t] <- t(lossdistCZ(p[,t], issuerweights, 1-S, Ngrid, 0, rho, Z))
}
for(i in 1:n.int){
- result[,i] <- tranche.pvvec(Kmodified, L[i,,], R[i,,], cs)
+ result[,i] <- tranche.pvvec(Kmodified, L[i,,], R[i,,], cs) - acc
}
## solve the optimization problem
program <- KLfit(100*(result[bottomup,]+1), w, tranche.upf[bottomup])
diff --git a/R/tranche_functions.R b/R/tranche_functions.R index 6f228620..39fd0b4d 100644 --- a/R/tranche_functions.R +++ b/R/tranche_functions.R @@ -721,7 +721,7 @@ BCtranche.pv <- function(portfolio, index, coupon, K1, K2, rho1, rho2, N=length( }
}
SurvProb <- SPmatrix(portfolio, index)
- cs <- couponSchedule(nextIMMDate(Sys.Date()), index$maturity, "Q", "FIXED", coupon, 0)
+ cs <- couponSchedule(IMMDate(Sys.Date()), index$maturity, "Q", "FIXED", coupon, 0)
recov <- sapply(portfolio, attr, "recovery")
issuerweights <- rep(1/length(portfolio), length(portfolio))
K <- adjust.attachments(c(K1,K2), index$loss, index$factor)
|