From c8f3641e59b3bcc147b4b5d8e8861338878bae5b Mon Sep 17 00:00:00 2001
From: Guillaume Horel <guillaume.horel@serenitascapital.com>
Date: Wed, 20 Aug 2014 15:25:59 -0400
Subject: add two new MF functions

---
 R/tranche_functions.R | 49 ++++++++++++++++++++++++++++++-------------------
 1 file changed, 30 insertions(+), 19 deletions(-)

diff --git a/R/tranche_functions.R b/R/tranche_functions.R
index 39888d9..32a4859 100644
--- a/R/tranche_functions.R
+++ b/R/tranche_functions.R
@@ -251,7 +251,8 @@ lossdistCblas <- function(p, w, S, N, defaultflag=FALSE){
        as.double(w), as.double(S), as.integer(N), as.logical(defaultflag), q = double(N))$q
 }
 
-lossdistCZ <- function(p, w, S, N, defaultflag=FALSE, rho, Z, wZ){
+lossdistCZ <- function(p, w, S, N, defaultflag=FALSE, rho, Z){
+    #S is of size (length(p), length(Z))
     .C("lossdistrib_Z", as.double(p), as.integer(length(p)),
        as.double(w), as.double(S), as.integer(N), as.logical(defaultflag),
        as.double(rho), as.double(Z), as.integer(length(Z)),
@@ -282,7 +283,6 @@ lossdistC.jointblas <- function(p, w, S, N, defaultflag=FALSE){
        as.double(S), as.integer(N), as.logical(defaultflag), q = matrix(0, N, N))$q
 }
 
-
 lossdistC.jointZ <- function(dp, w, S, N, defaultflag = FALSE, rho, Z, wZ){
     ## N is the size of the grid
     ## dp is of size n.credits
@@ -604,7 +604,6 @@ tranche.pv.scenarios <- function(l, r, cs, K1, K2){
            tranche.cl.scenarios(l, r, cs, K1, K2, TRUE))
 }
 
-
 adjust.attachments <- function(K, losstodate, factor){
     ## computes the attachments adjusted for losses
     ## on current notional
@@ -997,24 +996,36 @@ MFlossdist.prepay.joint <- function(w, Z, rho, defaultprob, defaultprobmod,
   return( Q )
 }
 
-MFtranche.pv <- function(cl, cs, w, rho, defaultprob, defaultprobmod, issuerweights, recov,
-                         Kmodified, Ngrid=length(issuerweights)+1){
-    ## computes the tranches pv using the modified factor distribution
-    ## p is the modified probability so that
-    n.credit <- length(issuerweights)
-    Rstoch <- array(0, dim=c(n.int, n.credit, ncol(defaultprob)))
-    for(t in 1:ncol(defaultprob)){
+MFrecovery <- function(index, defaultprobmod){
+    n.credit <- length(index$issuerweights)
+    n.int <- length(index$Z)
+    Rstoch <- array(0, dim=c(n.credit, n.int, ncol(index$defaultprob)))
+    rho <- rep(0.45, n.credit)
+    for(t in 1:ncol(index$defaultprob)){
         for(i in 1:n.credit){
-            Rstoch[,i,t] <- stochasticrecov(recov[i], 0, Z, w, rho, defaultprob[i,t], defaultprobmod[i,t])
+            Rstoch[i,,t] <- stochasticrecovC(index$recov[i], 0, index$Z, index$w.mod,
+                                             rho, index$defaultprob[i,t], defaultprobmod[i,t])
         }
     }
-    parf <- function(i){
-        pshocked <- apply(defaultprobmod, 2, shockprob, rho=rho, Z=Z[i])
-        S <- 1 - Rstoch[i,,]
-        dist <- lossrecovdist.term(pshocked, 0, issuerweights, S, Ngrid)
-        return( tranche.pvvec(Kmodified, dist$L, dist$R, cs))
+    return( Rstoch )
+}
+
+MFdist <- function(index){
+    rho <- rep(0.45, n.credit)
+    defaultprobmod <- MFupdate.probC(index$Z, index$w.mod, rho, index$defaultprob)
+    n.credit <- length(index$issuerweights)
+    n.int <- length(index$Z)
+    Rstoch <- MFrecovery(index, defaultprobmod)
+    Lw <- matrix(0, index$N, n.int)
+    Rw <- matrix(0, index$N, n.int)
+    L <- matrix(0, index$N, ncol(index$defaultprob))
+    R <- matrix(0, index$N, ncol(index$defaultprob))
+    for(t in 1:ncol(index$defaultprob)){
+        S <- 1 - Rstoch[,,t]
+        Lw <- lossdistCZ(defaultprobmod[,t], index$issuerweights, S, index$N, 0, rho, index$Z)
+        Rw <- lossdistCZ(defaultprobmod[,t], index$issuerweights, 1-S, Ngrid, 0, rho, index$Z)
+        L[,t] <- Lw%*%index$w.mod
+        R[,t] <- Rw%*%index$w.mod
     }
-    clusterExport(cl, list("Rstoch", "p"), envir=environment())
-    result <- parSapply(cl, 1:length(w), parf)
-    return( list(pv=100*(1+result%*%w), pv.w=result))
+    return(list(L=L, R=R))
 }
-- 
cgit v1.2.3-70-g09d2