diff options
Diffstat (limited to 'R/cds_functions_generic.R')
| -rw-r--r-- | R/cds_functions_generic.R | 664 |
1 files changed, 664 insertions, 0 deletions
diff --git a/R/cds_functions_generic.R b/R/cds_functions_generic.R new file mode 100644 index 00000000..e6e5a654 --- /dev/null +++ b/R/cds_functions_generic.R @@ -0,0 +1,664 @@ +source("cds_utils.R")
+
+## TODO:
+## - switch hazard rates and prepay curves to functions
+## - allow to compute forward quantities (works for couponleg and defauleg now,
+## if provide startdate
+
+setClass("abstractcurve")
+## flat hazard rate curve
+setClass("flatcurve", contains="abstractcurve", representation(h="numeric"))
+## shaped curve: the hazard rate curve is given by scaling a base shape by a factor
+## k(h)=alpha*exp(-beta*h)
+setClass("shapedcurve", contains="abstractcurve", representation(h="numeric",
+ shape="function", alpha="numeric", beta="numeric"))
+setClass("defaultcurve", contains="abstractcurve", representation(dates="Date", hazardrates="numeric"))
+setClass("defaultprepaycurve", representation(prepayrates="numeric"), contains="defaultcurve")
+setClass("creditcurve", representation(issuer="character", startdate="Date",
+ recovery="numeric", curve="defaultcurve"))
+
+shapedtodpc <- function(cs, sc, startdate=today()){
+ ## convert a shaped curve to a standard defaultprepaycuve
+ 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)
+ return (dpc)
+}
+
+## define couponleg generic
+setGeneric("couponleg", function(cs, sc, ...) {
+ standardGeneric("couponleg")
+})
+
+## write couponleg methods for the four types of curves
+setMethod("couponleg", signature("data.frame", "flatcurve"),
+ function(cs, sc, accruedondefault=TRUE){
+ T <- yearFrac(today(), 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))
+ hfun <- approxfun(x1T, sc@hazardrates, method="constant", rule=2)
+ PD <- cumprod(exp(- hfun(x2T) * dT))
+ 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", "defaultprepaycurve"),
+ ## computes the pv of the risky coupon leg from the coupon schedule,
+ ## 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(startdate, cs$dates)
+ dT <- diff(c(0, x2T))
+ hfun <- approxfun(x1T, sc@hazardrates, method="constant", rule=2)
+ pfun <- approxfun(x1T, sc@prepayrates, method="constant", rule=2)
+ SP <- cumprod(exp( - (hfun(x2T) + pfun(x2T)) * dT))
+ if(accruedondefault){
+ SPadj <- 0.5 * (c(1, SP[-length(SP)]) + SP)
+ }else{
+ SPadj <- SP
+ }
+ return( as.numeric(crossprod(SPadj, cs$coupons * cs$df)) )
+ })
+
+k <- function(h, alpha=0.25, beta=15){
+ ## prepay rate as a function of the hazardrate
+ ## this is a decreasing function
+ ## alpha is the maximum prepay rate
+ return ( alpha * exp(- beta * h) )
+}
+
+setMethod("couponleg", signature("data.frame", "shapedcurve"),
+ ## computes the pv of the risky coupon leg from the coupon schedule,
+ ## 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, startdate), accruedondefault, startdate) )
+ })
+
+## define dcouponleg generic
+setGeneric("dcouponleg", function(cs, sc, index, ...) {
+ standardGeneric("dcouponleg")
+})
+
+setMethod("dcouponleg", signature("data.frame", "flatcurve", "missing"),
+ function(cs, sc, accruedondefault=TRUE){
+ T <- yearFrac(today(), cs$dates)
+ dPD <- -T * exp(- sc@h * T )
+ if(accruedondefault){
+ dPDadj <- 0.5 * (c(0, dPD[-length(dPD)]) + dPD)
+ }else{
+ dPDadj <- dPD
+ }
+ return( as.numeric(crossprod(dPDadj, cs$coupons * cs$df)) )
+ })
+
+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)))
+ PD <- cumprod(exp(-sc@hazardrates[1:length(dT)] * dT))
+ dPD <- -cumsum(index * dT) * PD
+ if(accruedondefault){
+ dPDadj <- 0.5 * (c(0, dPD[-length(PD)]) + dPD)
+ }else{
+ dPDadj <- dPD
+ }
+ return( as.numeric(crossprod( dPDadj, cs$coupons * cs$df)) )
+ })
+
+setMethod("dcouponleg", signature("data.frame", "shapedcurve", "missing"),
+ function(cs, sc, accruedondefault = TRUE){
+ T <- yearFrac(today(), cs$dates)
+ dT <- diff(c(0, T))
+ hvec <- sc@h * sc@shape(T)
+ kvec <- sc@alpha*exp(-sc@beta*hvec)
+ SP <- cumprod(exp( - (hvec + kvec ) * dT))
+ dSP <- -cumsum( dT * sc@shape(T) * (1 - sc@beta * kvec)) * SP
+ if(accruedondefault) {
+ dSPadj <- 0.5 *(c(0, dSP[-length(SP)]) + dSP)
+ }else{
+ SPadj <- dSP
+ }
+ return( as.numeric(crossprod(dSPadj, cs$coupons * cs$df)) )
+ })
+
+## setMethod("dcouponleg", signature("data.frame", "defaultprepaycurve", "numeric"),
+## ## derivative of couponleg.prepay with respect to hazardrate
+## ## 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)))
+## 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){
+## dSPadj <- 0.5 * (c(0, dSP[-length(SP)]) + dSP)
+## }else{
+## SPadj <- dSP
+## }
+## return( as.numeric(crossprod(dSPadj, cs$coupons * cs$df)) )
+## })
+
+## test.shape <- splinefun(0:5, rep(1,6))
+## eps <- 1e-8
+## test.sc.flat <- new("flatcurve", h=0.07)
+## test.sc <- new("shapedcurve", h=0.07, shape=test.shape, alpha=.25, beta=15)
+## test.scplus <- new("shapedcurve", h=0.07+eps, shape=test.shape, alpha=.25, beta=15)
+## test.scminus <- new("shapedcurve", h=0.07-eps, shape=test.shape, alpha=.25, beta=15)
+
+## (couponleg(cs, test.scplus)-couponleg(cs, test.scminus))/(2 * eps)
+
+
+## define cdsduration generic
+setGeneric("cdsduration", function(sc, maturity, ...) {
+ standardGeneric("cdsduration")
+})
+
+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)
+ couponleg(cs, sc, accruedondefault)
+ })
+
+## define defaultleg generic
+setGeneric("defaultleg", function(cs, sc, recovery, ...) {
+ standardGeneric("defaultleg")
+})
+
+## write defaultleg methods for the four types of curves
+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)
+ dT <- diff(c(0, T))
+ Q <- exp(-sc@h * T) * cs$df
+ Qmid <- 1/2 * (c(1, Q[-length(Q)]) + Q)
+ r <- (1 - recovery) * crossprod(sc@h * Qmid, dT)
+ return( as.numeric(r) )
+ })
+
+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)
+ 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)
+ r <- (1 - recovery) * crossprod(sc@hazardrates[1:length(dT)] * Qmid, dT)
+ return( as.numeric(r) )
+ })
+
+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()){
+ x2T <- yearFrac(startdate, cs$dates)
+ x1T <- yearFrac(today(), 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)
+ Q <- cumprod(exp(- (hfun(x2T)+pfun(x2T)) * dT)) * cs$df
+ Qmid <- 1/2 * (c(1, Q[-length(Q)]) + Q)
+ r <- (1 - recovery) * crossprod(hfun(x2T) * Qmid, dT)
+ return( as.numeric(r) )
+})
+
+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){
+ return( defaultleg(cs, shapedtodpc(cs, sc), recovery) )
+ })
+
+## define ddefaultleg generic
+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(today(), cs$dates)
+ dT <- diff(c(0, T))
+ dQ <- - T * exp(-sc@h * T) * cs$df
+ Q <- exp(-sc@h * T) * cs$df
+ Qmid <- 1/2 * (c(1, Q[-length(Q)]) + Q)
+ dQmid <- 1/2 * (c(0, dQ[-length(dQ)]) + dQ)
+ dr <- (1-recovery) * (crossprod(Qmid, dT) +sc@h * crossprod(dQmid, dT))
+ return( as.numeric(dr) )
+ })
+
+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)
+ dT <- diff(c(0,T))
+ Q <- cumprod(exp(-sc@hazardrates[1:length(dT)] * dT)) * cs$df
+ dQ <- - cumsum(index * dT) * Q
+ Qmid <- 1/2 * (c(1, Q[-length(Q)]) + Q)
+ dQmid <- 1/2 *(c(0, dQ[-length(dQ)]) + dQ)
+ dr <- (1-recovery) * (crossprod(index * Qmid, dT) + crossprod(sc@hazardrates * dQmid, dT))
+ return( as.numeric(dr) )
+})
+
+setMethod("ddefaultleg", signature("data.frame", "shapedcurve", "numeric", "missing"),
+ function(cs, sc, recovery) {
+ T <- yearFrac(today(), cs$dates)
+ dT <- diff(c(0, T))
+ hvec <- sc@shape(T) * sc@h
+ kvec <- sc@alpha * exp(-sc@beta * hvec)
+ Q <- cumprod(exp( -(hvec + kvec) * dT)) * cs$df
+ dQ <- -cumsum(sc@shape(T) * dT * (1 - sc@beta * kvec)) * Q
+ Qmid <- 1/2 * (c(1, Q[-length(Q)]) + Q)
+ dQmid <- 1/2 * (c(0, dQ[-length(dQ)]) + dQ)
+ dr <- (1-recovery)* (crossprod(sc@shape(T) * Qmid, dT) + crossprod(hvec * dQmid, dT))
+ return( as.numeric(dr) )
+ })
+
+## test.shape <- splinefun(0:5, seq(0.5,1,length=6))
+## eps <- 1e-8
+## test.sc.flat <- new("flatcurve", h=0.07)
+## test.sc <- new("shapedcurve", h=0.07, shape=test.shape, alpha=.25, beta=15)
+## test.scplus <- new("shapedcurve", h=0.07+eps, shape=test.shape, alpha=.25, beta=15)
+## test.scminus <- new("shapedcurve", h=0.07-eps, shape=test.shape, alpha=.25, beta=15)
+## (contingentleg(cs, test.scplus, 0.4) - contingentleg(cs, test.scminus, 0.4))/(2*eps)
+## dcontingentleg(cs, test.sc)
+
+## define contingentleg generic
+setGeneric("contingentleg", function(cs, sc, recovery, ...) {
+ standardGeneric("contingentleg")
+})
+
+## write contingentleg methods for the four types of curves
+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){
+ T <- yearFrac(today(), cs$dates)
+ dT <- diff(c(0, T))
+ Q <- exp(-sc@h * T) * cs$df
+ Qmid <- 1/2 * (c(1, Q[-length(Q)]) + Q)
+ r <- Q[length(cs$dates)] + recovery * sc@h * crossprod(Qmid, dT)
+ return( as.numeric(r))
+ })
+
+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)
+ 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)
+ r <- Q[length(cs$dates)] + recovery * crossprod(sc@hazardrates[1:length(dT)] * Qmid, dT)
+ return( as.numeric(r))
+ })
+
+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(startdate, cs$dates)
+ dT <- diff(c(0, x2T))
+ hfun <- approxfun(x1T, sc@hazardrates, method="constant", rule=2)
+ pfun <- approxfun(x1T, sc@prepayrates, method="constant", rule=2)
+ Q <- cumprod(exp( -(hfun(x2T)+pfun(x2T)) * dT)) * cs$df
+ Qmid <- 1/2 * (c(1, Q[-length(Q)]) + Q)
+ r <- recovery * crossprod(hfun(x2T) * Qmid, dT) +
+ crossprod(pfun(x2T) * Qmid, dT) + Q[length(cs$dates)]
+ return( as.numeric(r) )
+ })
+
+setMethod("contingentleg", signature("data.frame", "shapedcurve", "numeric"),
+ function(cs, sc, recovery, startdate=today()){
+ return( contingentleg(cs, shapedtodpc(cs, sc), recovery, startdate) )
+ })
+
+## define dcontingentleg generic
+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(today(), cs$dates)
+ dT <- diff(c(0,T))
+ Q <- cumprod(exp(-sc@hazardrates[1:length(dT)] * dT)) * cs$df
+ dQ <- - cumsum(index * dT) * Q
+ Qmid <- 1/2 * (c(1, Q[-length(Q)]) + Q)
+ dQmid <- 1/2 * (c(0, dQ[-length(dQ)])+ dQ)
+ dr <- dQ[length(cs$dates)] + recovery * crossprod(index * Qmid, dT) +
+ recovery * crossprod(sc@hazardrates[1:length(dT)] * dQmid, dT)
+ return( as.numeric(dr) )
+ })
+
+setMethod("dcontingentleg", signature("data.frame", "defaultcurve", "numeric", "missing"),
+ ## derivative of contingentleg with respect to hazardrate
+ function(cs, sc, recovery){
+ ## derivative of contingentleg with respect to hazardrate
+ T <- yearFrac(today(), cs$dates)
+ dT <- diff(c(0, T))
+ Q <- exp(-sc@h * T) * cs$df
+ dQ <- -T * exp(- sc@h * T) * cs$df
+ Qmid <- 1/2 * (c(1, Q[-length(Q)]) + Q)
+ dr <- dQ[length(dQ)] + recovery * crossprod(Qmid, dT) +
+ recovery * h * crossprod(1/2 * (c(0, dQ[-length(dQ)]) + dQ), dT)
+ return( as.numeric(dr) )
+ })
+
+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(today(), cs$dates)
+ dT <- diff(c(0, T))
+ hvec <- sc@shape(T) * sc@h
+ kvec <- sc@alpha * exp( - sc@beta *hvec)
+ Q <- cumprod(exp( -(hvec + kvec) * dT)) * cs$df
+ dQ <- -cumsum(sc@shape(T) * dT * (1 - sc@beta * kvec)) * Q
+ Qmid <- 1/2 * (c(1, Q[-length(Q)]) + Q)
+ dQmid <- 1/2 * (c(0, dQ[-length(dQ)]) + dQ)
+ dr <- recovery * (crossprod(sc@shape(T) * Qmid, dT) + crossprod(hvec * dQmid, dT)) +
+ crossprod(-sc@beta * sc@shape(T) * kvec * Qmid, dT) +
+ crossprod(kvec * dQmid, dT) + dQ[length(cs$dates)]
+ return( as.numeric(dr) )
+ })
+
+cdspv <- function(cs, sc, recovery){
+ return ( couponleg(cs, sc) - defaultleg(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)
+ defaultleg(cs, sc, recovery)/couponleg(cs, sc)
+}
+
+dcdspv <- function(cs, sc, recovery, index=NULL){
+ if(is.null(index)){
+ return(dcouponleg(cs, sc)-ddefaultleg(cs, sc, recovery))
+ }else{
+ return ( dcouponleg(cs, sc, index) - ddefaultleg(cs, sc, recovery, index) )
+ }
+}
+
+bondpv <- function(cs, sc, recovery){
+ return( contingentleg(cs, sc, recovery)+couponleg(cs, sc) )
+}
+
+dbondpv <- function(cs, sc, recovery, index=NULL){
+ if(is.null(index)){
+ return( dcontingentleg(cs, sc, recovery) + dcouponleg(cs, sc))
+ }else{
+ return( dcontingentleg(cs, sc, recovery, index)+dcouponleg(cs, sc, 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(today()), maturity, "Q", "FIXED", running)
+ sc <- new("flatcurve", h = 0.05)
+ eps <- 1e-8
+ while(abs(cdspv(cs, sc, R) + upfront) > eps){
+ sc@h <- sc@h - (upfront + cdspv(cs, sc, R))/dcdspv(cs, sc, R)
+ }
+ return(sc@h)
+}
+
+cdshazardrate.shaped <- function(upfront, running, maturity, shape, R=0.4) {
+ cs <- couponSchedule(nextIMMDate(today()), 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){
+ sc@h <- sc@h - (upfront + cdspv(cs, sc, R))/dcdspv(cs, sc, R)
+ }
+ return(sc)
+}
+
+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()
+ hvec <- c()
+ previous.hvec <- c()
+ eps <- 1e-8
+ previous.cs <- data.frame()
+ for(i in 1:nrow(quotes)){
+ if(is.na(quotes$upfront[i])){
+ next
+ }
+ maturity <- quotes$maturity[i]
+ cs <- couponSchedule(nextIMMDate(today()), maturity, "Q", "FIXED", quotes$running[i])
+ 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)
+ hvec <- c(previous.hvec, rep(new.h, flength))
+ sc@hazardrates <- hvec
+ }
+ previous.hvec <- hvec
+ previous.maturity <- maturity
+ previous.cs <- cs
+ }
+ return(sc)
+}
+
+bondhazardrate.shaped <- function(collateral, shape, R=0.4, alpha=0.25, beta=15){
+ ## calibrate a default prepay curve to the collateral information
+ cs <- couponSchedule(collateral$nextpaydate, collateral$maturity,
+ collateral$frequency, collateral$fixedorfloat,
+ collateral$grosscoupon*0.01, collateral$spread*0.01)
+ sc <- new("shapedcurve", h=0.05, shape=shape, alpha=alpha, beta=beta)
+ eps <- 1e-8
+ counter <- 0
+ while(abs(bondpv(cs, sc, R) - collateral$price/100) > eps){
+ dh <- (collateral$price/100 - bondpv(cs, sc, R))/dbondpv(cs, sc, R)
+ while(sc@h+dh<0){
+ dh <- 0.5 * dh
+ }
+ sc@h <- sc@h+dh
+ counter <- counter+1
+ if(counter>=100){
+ return( NULL )
+ stop("didn't reach convergence")
+ }
+ }
+ return( shapedtodpc(cs, sc) )
+}
+
+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)
+ 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)
+ pl[i] <- defaultleg(cs, tweakedcurve, portfolio[[i]]@recovery)
+ }else{
+ cl[i] <- couponleg(cs, portfolio[[i]]@curve, portfolio[[i]]@recovery)
+ pl[i] <- defaultleg(cs, portfolio[[i]]@curve, portfolio[[i]]@recovery)
+ }
+ }
+ return( list(cl=mean(cl), pl=mean(pl), bp=1+mean(cl-pl)))
+}
+
+indexduration <- function(portfolio, index){
+ ## compute the duration of a portfolio of survival curves
+ durations <- sapply(sapply(portfolio, attr, "curve"), cdsduration, index$maturity)
+ return( mean(durations) )
+}
+
+indexspread <- function(portfolio, index){
+ ## computes the spread of a portfolio of survival curves
+ ## S <- 0
+ ## d <- rep(0, length(portfolio))
+ ## for(i in 1:length(portfolio)){
+ ## d[i] <- cdsduration(portfolio[[i]]@curve, index$maturity)
+ ## S <- S + d[i] * cdsspread(portfolio[[i]]@curve, index$maturity, portfolio[[i]]@recovery)
+ ## }
+ S <- hy17$coupon-(indexpv(portfolio, index)-1)/indexduration(portfolio, index)
+ return(S)
+}
+
+tweakcurves <- function(portfolio, index){
+ ## computes the tweaking factor
+ epsilon <- 0
+ f <- function(epsilon, ...){
+ abs(indexpv(portfolio, index, epsilon)$bp-index$indexref)
+ }
+ epsilon <- optimize(f, c(-0.5, 0.5), portfolio, index, tol=1e-6)$minimum
+ portfolio.new <- portfolio
+ for(i in 1:length(portfolio)){
+ portfolio.new[[i]]@curve@hazardrates <- portfolio[[i]]@curve@hazardrates * (1 + epsilon)
+ }
+ return( portfolio.new )
+}
+
+survivalProbability1 <- function(startdate, date, survival.curve) {
+ #based on a flat hazard rate curve
+ T <- yearFrac(startdate, survival.curve$dates)
+ Tmat <- yearFrac(startdate, date)
+ for ( i in 1:length(survival.curve$dates) ){
+ if ( date >= survival.curve$dates[i] ) {
+ next
+ }else{
+ if( i > 1 ) {
+ w <- ( Tmat - T[i-1] ) / (T[i] - T[i-1])
+ logprob <- - (1-w) * survival.curve$hazardrates[i-1] * T[i-1] -
+ w * survival.curve$hazardrates[i] * T[i]
+ }else{
+ logprob <- - Tmat * survival.curve$hazardrates[1]
+ return( exp(as.numeric(logprob)) )
+ }
+ }
+ }
+ ## if date is greater than last survival.curve date, keep the hazard rate flate
+ logprob <- - yearFrac(startdate, date) * survival.curve$hazardrates[i]
+ return( exp(as.numeric(logprob)) )
+}
+
+survivalProbability.exact <- function(credit.curve, date) {
+ #based on a forward hazard rate curve
+ curve <- credit.curve@curve
+ T <- c(0, yearFrac(credit.curve@startdate, curve@dates))
+ dT <- diff(T)
+ Tmat <- yearFrac(credit.curve@startdate, date)
+ logprob <- 0
+ for ( i in 1:length(dT) ){
+ if ( date > curve@dates[i] ) {
+ logprob <- logprob - curve@hazardrates[i] * dT[i]
+ }else{
+ if( i > 1 ){
+ logprob <- logprob - curve@hazardrates[i] * (Tmat - T[i])
+ }else{
+ logprob <- logprob - curve@hazardrates[1] * Tmat
+ }
+ break
+ }
+ }
+ return( exp(as.numeric(logprob)) )
+}
+
+SP <- function(sc){
+ ## computes the survival probability associated with the survival curve
+ T <- c(0, yearFrac(today(), sc@dates))
+ dT <- diff(T)
+ return( cumprod(exp(-sc@hazardrates * dT)) )
+}
+
+
+SPmatrix <- function(portfolio, index){
+ ## computes matrix of survival probability
+ ## inputs:
+ ## portfolio: portfolio of survival curves
+ ## index: index representation
+ ## ouput:
+ ## 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)
+ SP <- matrix(0, length(portfolio), length(cs$dates))
+ for(i in 1:length(portfolio)){
+ SP[i,] <- SP(portfolio[[i]]@curve)[1:length(cs$dates)]
+ }
+ return( SP )
+}
+
+DP2 <- function(sc, dates){
+ ## computes the default probability and prepay probability associated
+ ## with the survival curve at the dates specified by dates
+ x2T <- yearFrac(today(), dates)
+ dT <- diff(c(0, x2T))
+ x1T <- yearFrac(today(), sc@dates)
+ hfun <- approxfun(x1T, sc@hazardrates, method="constant", rule=2)
+ pfun <- approxfun(x1T, sc@prepayrates, method="constant", rule=2)
+ Qmid <- exp(-cumsum((hfun(x2T)+pfun(x2T)) * dT))
+ list(defaultprob = cumsum(hfun(x2T) * Qmid * dT),
+ prepayprob = cumsum(pfun(x2T) * Qmid * dT))
+}
+
+getdealschedule <- function(dealdata, freq="3 months"){
+ dates <- seq(dealdata$"Deal Next Pay Date", dealdata$maturity, by=freq)
+ dates <- dates[dates>today()]
+ return( dates )
+}
+
+SPmatrix2 <- function(portfolio, dealdata, freq="3 months"){
+ ## computes the default and prepay probability matrix of a portfolio
+ ## at the dates specified from dealdata
+ dates <- getdealschedule(dealdata, freq)
+ 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, dates)
+ DP[i,] <- temp$defaultprob
+ PP[i,] <- temp$prepayprob
+ }
+ return(list(DP=DP, PP=PP))
+}
+
+forwardportfolioprice <- function(portfolio, startdate, rollingmaturity, coupontype, margin, recovery){
+ forwardcs <- couponSchedule(nextpaydate=startdate+45, maturity=startdate+rollingmaturity,
+ frequency="Q", "FLOAT", margin, margin, startdate=startdate)
+ r <- rep(0, length(portfolio$SC))
+ for(i in 1:length(portfolio$SC)){
+ cl <- couponleg(forwardcs, portfolio$SC[[i]]@curve, startdate=startdate)
+ pl <- contingentleg(forwardcs, portfolio$SC[[1]]@curve, portfolio$SC[[i]]@recovery, startdate=startdate)
+ r[i] <- pl+cl
+ }
+ return(mean(r))
+}
|