diff options
Diffstat (limited to 'cds_functions_generic.R')
| -rw-r--r-- | cds_functions_generic.R | 664 |
1 files changed, 0 insertions, 664 deletions
diff --git a/cds_functions_generic.R b/cds_functions_generic.R deleted file mode 100644 index e6e5a654..00000000 --- a/cds_functions_generic.R +++ /dev/null @@ -1,664 +0,0 @@ -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))
-}
|