aboutsummaryrefslogtreecommitdiffstats
path: root/R
diff options
context:
space:
mode:
Diffstat (limited to 'R')
-rw-r--r--R/cds_functions_generic.R125
1 files changed, 70 insertions, 55 deletions
diff --git a/R/cds_functions_generic.R b/R/cds_functions_generic.R
index 40912cde..18342e07 100644
--- a/R/cds_functions_generic.R
+++ b/R/cds_functions_generic.R
@@ -25,7 +25,7 @@ setClass("creditcurve", representation(issuer="character", startdate="Date",
shapedtodpc <- function(cs, sc){
## convert a shaped curve to a standard defaultprepaycuve
- T <- yearFrac(today(), cs$dates)
+ T <- yearFrac(Sys.Date(), 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)
@@ -39,24 +39,28 @@ setGeneric("couponleg", function(cs, sc, ...) {
## write couponleg methods for the four types of curves
setMethod("couponleg", signature("data.frame", "flatcurve"),
- function(cs, sc, accruedondefault=TRUE, startdate=today()){
- T <- yearFrac(startdate, cs$dates)
- PD <- exp(- sc@h * T )
- if(accruedondefault){
- PDadj <- 0.5 * (c(1, PD[-length(PD)]) + PD)
- }else{
- PDadj <- PD
- }
- return( as.numeric(crossprod(PDadj, cs$coupons * cs$df)) )
- })
+ function(cs, sc, startdate=Sys.Date(), accruedondefault=TRUE){
+ stopifnot(class(startdate)=="Date")
+ stopifnot(is.logical(accruedondefault))
+ T <- yearFrac(startdate, cs$dates)
+ PD <- exp(- sc@h * T )
+ if(accruedondefault){
+ PDadj <- 0.5 * (c(1, PD[-length(PD)]) + PD)
+ }else{
+ PDadj <- PD
+ }
+ return( as.numeric(crossprod(PDadj, cs$coupons * cs$df)) )
+ })
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, accruedondefault=TRUE){
- x1T <- yearFrac(today(), sc@dates)
- x2T <- yearFrac(today(), cs$dates)
- dT <- diff(c(0, x2T))
+ function(cs, sc, stardate=Sys.Date(), accruedondefault=TRUE){
+ stopifnot(class(startdate)=="Date")
+ stopifnot(is.logical(accruedondefault))
+ x1T <- yearFrac(Sys.Date(), sc@dates)
+ x2T <- yearFrac(Sys.Date(), 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))
if(accruedondefault){
@@ -73,9 +77,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, accruedondefault=TRUE, startdate=today()){
- x1T <- yearFrac(today(), sc@dates)
- x2T <- yearFrac(today(), cs$dates)
+ function(cs, sc, startdate=Sys.Date(), accruedondefault=TRUE){
+ stopifnot(class(startdate)=="Date")
+ stopifnot(is.logical(accruedondefault))
+ x1T <- yearFrac(Sys.Date(), sc@dates)
+ x2T <- yearFrac(Sys.Date(), 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)
@@ -100,8 +106,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, accruedondefault=TRUE, startdate=today()){
- return( couponleg(cs, shapedtodpc(cs, sc), accruedondefault, startdate) )
+ function(cs, sc, startdate=Sys.Date(), accruedondefault=TRUE){
+ stopifnot(class(startdate)=="Date")
+ stopifnot(is.logical(accruedondefault))
+ return( couponleg(cs, shapedtodpc(cs, sc), startdate, accruedondefault) )
})
## define dcouponleg generic
@@ -111,7 +119,8 @@ setGeneric("dcouponleg", function(cs, sc, index, ...) {
setMethod("dcouponleg", signature("data.frame", "flatcurve", "missing"),
function(cs, sc, accruedondefault=TRUE){
- T <- yearFrac(today(), cs$dates)
+ stopifnot(is.logical(accruedondefault))
+ T <- yearFrac(Sys.Date(), cs$dates)
dPD <- -T * exp(- sc@h * T )
if(accruedondefault){
dPDadj <- 0.5 * (c(0, dPD[-length(dPD)]) + dPD)
@@ -124,7 +133,8 @@ 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) {
- dT <- diff(c(0, yearFrac(today(), cs$dates)))
+ stopifnot(is.logical(accruedondefault))
+ dT <- diff(c(0, yearFrac(Sys.Date(), cs$dates)))
PD <- cumprod(exp(-sc@hazardrates[1:length(dT)] * dT))
dPD <- -cumsum(index * dT) * PD
if(accruedondefault){
@@ -137,7 +147,7 @@ setMethod("dcouponleg", signature("data.frame", "defaultcurve", "numeric"),
setMethod("dcouponleg", signature("data.frame", "shapedcurve", "missing"),
function(cs, sc, accruedondefault = TRUE){
- T <- yearFrac(today(), cs$dates)
+ T <- yearFrac(Sys.Date(), cs$dates)
dT <- diff(c(0, T))
hvec <- sc@h * sc@shape(T)
kvec <- sc@alpha*exp(-sc@beta*hvec)
@@ -156,7 +166,7 @@ setMethod("dcouponleg", signature("data.frame", "shapedcurve", "missing"),
## ## If k is the prepay rate, it assumes dk/dh = - beta * k,
## ## which is the case if k(h) = alpha * exp(-beta *h)
## function(cs, dpc, index, beta, accruedondefault=TRUE) {
-## dT <- diff(c(0, yearFrac(today(), cs$dates)))
+## dT <- diff(c(0, yearFrac(Sys.Date(), cs$dates)))
## SP <- cumprod(exp( - (dpc@hazardrates[1:length(dT)] + dpc@prepayrates[1:length(dT)] ) * dT))
## dSP <- -cumsum(index * dT * (1 - beta * dpc@prepayrates[1:length(dT)])) * SP
## if(accruedondefault){
@@ -176,7 +186,8 @@ setGeneric("cdsduration", function(sc, maturity, ...) {
setMethod("cdsduration", signature("abstractcurve", "Date"),
## computes the risky PV01, also called risky annuity of a cds
function(sc, maturity, accruedondefault=TRUE){
- cs <- couponSchedule(nextIMMDate(today()), maturity, "Q", "FIXED", 1)
+ stopifnot(is.logical(accruedondefault))
+ cs <- couponSchedule(nextIMMDate(Sys.Date()), maturity, "Q", "FIXED", 1)
couponleg(cs, sc, accruedondefault)
})
@@ -190,7 +201,7 @@ 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(today(), cs$dates)
+ T <- yearFrac(Sys.Date(), cs$dates)
dT <- diff(c(0, T))
Q <- exp(-sc@h * T) * cs$df
Qmid <- 1/2 * (c(1, Q[-length(Q)]) + Q)
@@ -202,7 +213,7 @@ 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(today(), cs$dates)
+ T <- yearFrac(Sys.Date(), 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)
@@ -213,9 +224,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=today()){
+ function(cs, sc, recovery, startdate=Sys.Date()){
+ stopifnot(class(stardate)=="Date")
x2T <- yearFrac(startdate, cs$dates)
- x1T <- yearFrac(today(), sc@dates)
+ x1T <- yearFrac(Sys.Date(), 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)
@@ -239,7 +251,7 @@ setGeneric("ddefaultleg", function(cs, sc, recovery, index) {
setMethod("ddefaultleg", signature("data.frame", "flatcurve", "numeric", "missing"),
## derivative of defaultleg with respect to flat hazardrate
function(cs, sc, recovery){
- T <- yearFrac(today(), cs$dates)
+ T <- yearFrac(Sys.Date(), cs$dates)
dT <- diff(c(0, T))
dQ <- - T * exp(-sc@h * T) * cs$df
Q <- exp(-sc@h * T) * cs$df
@@ -252,7 +264,7 @@ 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(today(), cs$dates)
+ T <- yearFrac(Sys.Date(), cs$dates)
dT <- diff(c(0,T))
Q <- cumprod(exp(-sc@hazardrates[1:length(dT)] * dT)) * cs$df
dQ <- - cumsum(index * dT) * Q
@@ -264,7 +276,7 @@ setMethod("ddefaultleg", signature("data.frame", "defaultcurve", "numeric", "num
setMethod("ddefaultleg", signature("data.frame", "shapedcurve", "numeric", "missing"),
function(cs, sc, recovery) {
- T <- yearFrac(today(), cs$dates)
+ T <- yearFrac(Sys.Date(), cs$dates)
dT <- diff(c(0, T))
hvec <- sc@shape(T) * sc@h
kvec <- sc@alpha * exp(-sc@beta * hvec)
@@ -294,7 +306,8 @@ setGeneric("contingentleg", function(cs, sc, recovery, ...) {
setMethod("contingentleg", signature("data.frame", "flatcurve", "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, startdate=today()){
+ function(cs, sc, recovery, startdate=Sys.Date()){
+ stopifnot(class(startdate)=="Date")
T <- yearFrac(startdate, cs$dates)
dT <- diff(c(0, T))
Q <- exp(-sc@h * T) * cs$df
@@ -307,7 +320,7 @@ 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(today(), cs$dates)
+ T <- yearFrac(Sys.Date(), 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)
@@ -318,9 +331,10 @@ setMethod("contingentleg", signature("data.frame", "defaultcurve", "numeric"),
setMethod("contingentleg", signature("data.frame", "defaultprepaycurve", "numeric"),
## 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, startdate=today()) {
- x1T <- yearFrac(today(), sc@dates)
- x2T <- yearFrac(today(), cs$dates)
+ function(cs, sc, recovery, startdate=Sys.Date()) {
+ stopifnot(class(startdate)=="Date")
+ x1T <- yearFrac(Sys.Date(), sc@dates)
+ x2T <- yearFrac(Sys.Date(), 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)
@@ -332,7 +346,8 @@ setMethod("contingentleg", signature("data.frame", "defaultprepaycurve", "numeri
})
setMethod("contingentleg", signature("data.frame", "shapedcurve", "numeric"),
- function(cs, sc, recovery, startdate=today()){
+ function(cs, sc, recovery, startdate=Sys.Date()){
+ stopifnot(class(startdate)=="Date")
return( contingentleg(cs, shapedtodpc(cs, sc), recovery, startdate) )
})
@@ -344,7 +359,7 @@ setGeneric("dcontingentleg", function(cs, sc, recovery, index) {
setMethod("dcontingentleg", signature("data.frame", "defaultcurve", "numeric", "numeric"),
## derivative of contingentleg with respect to hazardrate
function(cs, sc, recovery, index){
- T <- yearFrac(today(), cs$dates)
+ T <- yearFrac(Sys.Date(), cs$dates)
dT <- diff(c(0,T))
Q <- cumprod(exp(-sc@hazardrates[1:length(dT)] * dT)) * cs$df
dQ <- - cumsum(index * dT) * Q
@@ -359,7 +374,7 @@ setMethod("dcontingentleg", signature("data.frame", "defaultcurve", "numeric", "
## derivative of contingentleg with respect to hazardrate
function(cs, sc, recovery){
## derivative of contingentleg with respect to hazardrate
- T <- yearFrac(today(), cs$dates)
+ T <- yearFrac(Sys.Date(), cs$dates)
dT <- diff(c(0, T))
Q <- exp(-sc@h * T) * cs$df
dQ <- -T * exp(- sc@h * T) * cs$df
@@ -373,7 +388,7 @@ setMethod("dcontingentleg", signature("data.frame", "shapedcurve", "numeric", "m
## 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(today(), cs$dates)
+ T <- yearFrac(Sys.Date(), cs$dates)
dT <- diff(c(0, T))
hvec <- sc@shape(T) * sc@h
kvec <- sc@alpha * exp( - sc@beta *hvec)
@@ -394,12 +409,12 @@ cdspv <- function(cs, sc, recovery){
cdsspread <- function(sc, maturity, recovery){
## computes exact cds running spread for a cds
## should be very close to hazardrate * (1-recovery)
- cs <- couponSchedule(nextIMMDate(today()), maturity, "Q", "FIXED", 1)
+ cs <- couponSchedule(nextIMMDate(Sys.Date()), maturity, "Q", "FIXED", 1)
defaultleg(cs, sc, recovery)/couponleg(cs, sc)
}
-dcdspv <- function(cs, sc, recovery, index=NULL){
- if(is.null(index)){
+dcdspv <- function(cs, sc, recovery, index){
+ if(is.missing(index)){
return(dcouponleg(cs, sc)-ddefaultleg(cs, sc, recovery))
}else{
return ( dcouponleg(cs, sc, index) - ddefaultleg(cs, sc, recovery, index) )
@@ -410,8 +425,8 @@ bondpv <- function(cs, sc, recovery){
return( contingentleg(cs, sc, recovery)+couponleg(cs, sc) )
}
-dbondpv <- function(cs, sc, recovery, index=NULL){
- if(is.null(index)){
+dbondpv <- function(cs, sc, recovery, index){
+ if(is.missing(index)){
return( dcontingentleg(cs, sc, recovery) + dcouponleg(cs, sc))
}else{
return( dcontingentleg(cs, sc, recovery, index)+dcouponleg(cs, sc, index) )
@@ -421,7 +436,7 @@ dbondpv <- function(cs, sc, recovery, index=NULL){
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(today()), maturity, "Q", "FIXED", running)
+ cs <- couponSchedule(nextIMMDate(Sys.Date()), maturity, "Q", "FIXED", running)
sc <- new("flatcurve", h = 0.05)
eps <- 1e-8
while(abs(cdspv(cs, sc, R) + upfront) > eps){
@@ -431,7 +446,7 @@ cdshazardrate.flat <- function(upfront, running, maturity, R=0.4){
}
cdshazardrate.shaped <- function(upfront, running, maturity, shape, R=0.4) {
- cs <- couponSchedule(nextIMMDate(today()), maturity, "Q", "FIXED", running)
+ cs <- couponSchedule(nextIMMDate(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){
@@ -443,7 +458,7 @@ cdshazardrate.shaped <- function(upfront, running, maturity, shape, R=0.4) {
cdshazardrate <- function(quotes, R=0.4){
## bootstrap the implied hazard rate curve of the cds based on the upfront
## and running quotes, as well as maturity and recovery
- previous.maturity <- today()
+ previous.maturity <- Sys.Date()
hvec <- c()
previous.hvec <- c()
eps <- 1e-8
@@ -453,7 +468,7 @@ cdshazardrate <- function(quotes, R=0.4){
next
}
maturity <- quotes$maturity[i]
- cs <- couponSchedule(nextIMMDate(today()), maturity, "Q", "FIXED", quotes$running[i])
+ cs <- couponSchedule(nextIMMDate(Sys.Date()), maturity, "Q", "FIXED", quotes$running[i])
new.h <- 0.05
flength <- nrow(cs) - nrow(previous.cs)
hvec <- c(previous.hvec, rep(new.h, flength))
@@ -504,15 +519,15 @@ indexpv <- function(portfolio, index, epsilon=0){
## computes the intrinsic index pv of a portfolio of cds
pl <- rep(0, length(portfolio))
cl <- rep(0, length(portfolio))
- cs <- couponSchedule(nextIMMDate(today()), index$maturity, "Q", "FIXED", index$coupon)
+ cs <- couponSchedule(nextIMMDate(Sys.Date()), index$maturity, "Q", "FIXED", index$coupon)
for(i in 1:length(portfolio)){
if(epsilon!=0){
tweakedcurve <- portfolio[[i]]@curve
tweakedcurve@hazardrates <- tweakedcurve@hazardrates * (1 + epsilon)
- cl[i] <- couponleg(cs, tweakedcurve, portfolio[[i]]@recovery)
+ cl[i] <- couponleg(cs, tweakedcurve)
pl[i] <- defaultleg(cs, tweakedcurve, portfolio[[i]]@recovery)
}else{
- cl[i] <- couponleg(cs, portfolio[[i]]@curve, portfolio[[i]]@recovery)
+ cl[i] <- couponleg(cs, portfolio[[i]]@curve)
pl[i] <- defaultleg(cs, portfolio[[i]]@curve, portfolio[[i]]@recovery)
}
}
@@ -639,7 +654,7 @@ survivalProbability.exact <- function(credit.curve, date) {
SP <- function(sc){
## computes the survival probability associated with the survival curve
- T <- c(0, yearFrac(today(), sc@dates))
+ T <- c(0, yearFrac(Sys.Date(), sc@dates))
dT <- diff(T)
return( cumprod(exp(-sc@hazardrates * dT)) )
}
@@ -654,7 +669,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(today()), index$maturity, "Q", "FIXED", index$coupon)
+ cs <- couponSchedule(nextIMMDate(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)]
generated by cgit v1.3 (git 2.53.0) at 2026-04-06 10:19:41 +0000