add a new method for skew mapping (probability matching)

1 files changed, 32 insertions, 6 deletions

diff --git a/R/tranche_functions.R b/R/tranche_functions.R
index a436de9..ce39b16 100644
--- a/R/tranche_functions.R
+++ b/R/tranche_functions.R
@@ -692,30 +692,47 @@ BCtranche.pv <- function(index, protection=FALSE){
 }

 

 adjust.skew <- function(index1, index2, method="ATM"){

-    #index1 is the index of which we already have computed the skew

+    #index1 is the index for which we already have computed the skew

     #index2 is the index we're mapping to

     # if method="ATM", do simple at the money mapping

     #    method="TLP", do tranche loss proportion mapping

-    el1 <- EL(index1)

-    el2 <- EL(index2)

+    #    method="PM", do probability matching

+

     K1 <- index2$K[-c(1,length(index1$K))]

     K2 <- index2$K[-c(1,length(index1$K))]

-    skew <- splinefun(K1, index1$rho[-c(1, length(index1$rho))], "natural")

     aux <- function(x, index1, el1, skew, index2, el2, K2){

         return(abs(ELtrunc(index1, x, skew(x))/el1-

                    ELtrunc(index2, K2, skew(x))/el2))

     }

+    aux2 <- function(x, index1, skew, index2, K2){

+        return(abs(log(Probtrunc(index1, x, skew(x)))-

+                   log(Probtrunc(index2, K2, skew(x)))))

+    }

+    if(method %in% c("ATM", "TLP")){

+        el1 <- EL(index1)

+        el2 <- EL(index2)

+    }

+    skew <- splinefun(K1, index1$rho[-c(1, length(index1$rho))], "natural")

     if(method=="ATM"){

         K1eq <- el1/el2 * K2

     }else if(method == "TLP"){

         K1eq <- c()

+        m <- max(K2) + 0.3

         for(K2val in K2){

-            prog <- optimize(aux, interval=c(0,1),

+            prog <- optimize(aux, interval=c(0,m),

                              index1=index1, el1=el1, skew=skew,

                              index2=index2, el2=el2, K2=K2val)

             K1eq <- c(K1eq, prog$minimum)

         }

-    }

+    }else if (method=="PM"){

+        K1eq <- c()

+        m <- max(K2) + 0.3

+        for(K2val in K2){

+            prog <- optimize(aux2, interval=c(0, m),

+                             index1=index1, skew=skew, index2=index2, K2=K2val)

+            K1eq <- c(K1eq, prog$minimum)

+        }

+     }

     return(c(0, skew(K1eq), NA))

 }

 

@@ -810,6 +827,15 @@ ELtrunc <- function(index, K, rho){
     return( -tranche.pl(dist$L, index$cs, 0, K) )

 }

 

+Probtrunc <- function(index, K, rho){

+    dist <- BClossdistC(index$defaultprob, index$issuerweights, index$recov, rho, index$Z, index$w, index$N)

+    p <- cumsum(dist$L[,ncol(dist$L)])

+    support <- seq(0, 1, length=index$N)

+    probfun <- splinefun(support, p, method="hyman")

+    return(probfun(K))

+}

+

+

 BCstrikes <- function(defaultprob, issuerweights, recov, cs, K, rho, Z, w, N=101) {

     ## computes the strikes as a percentage of expected loss

     ## Kmodified is the current attachment points (adjusted for losses)