diff options
Diffstat (limited to 'cds_functions_generic.R')
| -rw-r--r-- | cds_functions_generic.R | 574 |
1 files changed, 574 insertions, 0 deletions
diff --git a/cds_functions_generic.R b/cds_functions_generic.R new file mode 100644 index 00000000..d3f980a5 --- /dev/null +++ b/cds_functions_generic.R @@ -0,0 +1,574 @@ +source("cds_utils.R")
+
+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){
+ dT <- diff(c(0, yearFrac(today(), cs$dates)))
+ PD <- cumprod(exp(-sc@hazardrates[1:length(dT)] * 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){
+ dT <- diff(c(0, yearFrac(today(), cs$dates)))
+ SP <- cumprod(exp( - (sc@hazardrates[1:length(dT)] + sc@prepayrates[1:length(dT)] ) * 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){
+ return( couponleg(cs, shapedtodpc(cs, sc), accruedondefault) )
+ })
+
+## 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, accruedondefault) {
+ standardGeneric("cdsduration")
+})
+
+setMethod("cdsduration", signature("abstractcurve", "Date", "logical"),
+ ## 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){
+ T <- yearFrac(today(), cs$dates)
+ dT <- diff(c(0, T))
+ Q <- cumprod(exp(- (sc@hazardrates[1:length(dT)]+sc@prepayrates[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", "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) {
+ T <- yearFrac(today(), cs$dates)
+ dT <- diff(c(0, T))
+ Q <- cumprod(exp( -(sc@hazardrates[1:length(dT)]+sc@prepayrates[1:length(dT)]) * dT)) * cs$df
+ Qmid <- 1/2 * (c(1, Q[-length(Q)]) + Q)
+ r <- recovery * crossprod(sc@hazardrates[1:length(dT)] * Qmid, dT) +
+ crossprod(sc@prepayrates[1:length(dT)] * Qmid, dT) + Q[length(cs$dates)]
+ return( as.numeric(r) )
+ })
+
+setMethod("contingentleg", signature("data.frame", "shapedcurve", "numeric"),
+ function(cs, sc, recovery){
+ return( contingentleg(cs, shapedtodpc(cs, sc), recovery) )
+ })
+
+## 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
+ r <- 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)
+ r[i] <- cdspv(cs, tweakedcurve, portfolio[[i]]@recovery)
+ }else{
+ r[i] <- cdspv(cs, portfolio[[i]]@curve, portfolio[[i]]@recovery)
+ }
+ }
+ return( 1+mean(r) )
+}
+
+tweakcurves <- function(portfolio, index){
+ ## computes the tweaking factor
+ epsilon <- 0
+ f <- function(epsilon, ...){
+ abs(indexpv(portfolio, index, epsilon)-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)) )
+}
+
+PD <- function(sc){
+ ## computes the default probability associated with the survival curve
+ T <- c(0, yearFrac(today(), sc@dates))
+ dT <- diff(T)
+ return( 1-cumprod(exp(-sc@hazardrates * dT)) )
+}
+
+
+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)]
+ }
+ return( SP )
+}
|