1 files changed, 45 insertions, 27 deletions
diff --git a/cds_functions_generic.R b/cds_functions_generic.R
index e858ffe8..a17c2a1f 100644
--- a/cds_functions_generic.R
+++ b/cds_functions_generic.R
@@ -94,7 +94,7 @@ 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){
+          function(cs, sc, accruedondefault=TRUE, startdate=today()){
               return( couponleg(cs, shapedtodpc(cs, sc, startdate), accruedondefault, startdate) )
           })
 
@@ -289,7 +289,7 @@ setMethod("ddefaultleg", signature("data.frame", "shapedcurve", "numeric", "miss
 ## dcontingentleg(cs, test.sc)
 
 ## define contingentleg generic
-setGeneric("contingentleg", function(cs, sc, recovery) {
+setGeneric("contingentleg", function(cs, sc, recovery, ...) {
     standardGeneric("contingentleg")
 })
 
@@ -321,19 +321,22 @@ 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) {
-              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
+          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(sc@hazardrates[1:length(dT)] * Qmid, dT) +
-                  crossprod(sc@prepayrates[1:length(dT)] * Qmid, dT) + Q[length(cs$dates)]
+              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){
-             return( contingentleg(cs, shapedtodpc(cs, sc), recovery) )
+          function(cs, sc, recovery, startdate=today()){
+             return( contingentleg(cs, shapedtodpc(cs, sc), recovery, startdate) )
          })
 
 ## define dcontingentleg generic
@@ -616,33 +619,48 @@ SPmatrix <- function(portfolio, index){
     return( SP )
 }
 
-DP2 <- function(sc){
+DP2 <- function(sc, dates){
     ## computes the default probability and prepay probability associated
-    ## with the survival curve
-    T <- c(0, yearFrac(today(), sc@dates))
-    dT <- diff(T)
-    Q <- cumprod(exp(- (sc@hazardrates[1:length(dT)]+sc@prepayrates[1:length(dT)]) * dT))
+    ## 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)
+    Q <- cumprod(exp(-(hfun(x2T)+pfun(x2T)) * dT))
     Qmid <- 1/2 * (c(1, Q[-length(Q)]) + Q)
-    list(dates=T[-1],
-         defaultprob= cumsum(sc@hazardrates[1:length(dT)] * Qmid * dT),
-         prepayprob = cumsum(sc@prepayrates[1:length(dT)] * Qmid * dT))
+    list(defaultprob = cumsum(hfun(x2T) * Qmid * dT),
+         prepayprob = cumsum(pfun(x2T) * Qmid * dT))
 }
 
-SPmatrix2 <- function(portfolio, dealdata){
+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 <- seq(dealdata$"Deal Next Pay Date", dealdata$maturity, by="3 months")
-    dates <- dates[dates>today()]
-    T <- yearFrac(today(), dates)
+    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)
-        ## linear interpolation of the default and prepay prob
-        ## need to figure out a better way to do this
-        DP[i,] <- approxfun(temp$dates, temp$defaultprob, rule=2)(T)
-        PP[i,] <- approxfun(temp$dates, temp$prepayprob, rule=2)(T)
+        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){
+    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))
+}