diff options
Diffstat (limited to 'R/cds_functions_generic.R')
| -rw-r--r-- | R/cds_functions_generic.R | 154 |
1 files changed, 83 insertions, 71 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)]
|