Most functions now take a complement parameter

* set to FALSE by default, which was the previous behaviour
* when complement is TRUE, we build the tranches pv starting
  from the top, only makes sense if index$rho is a top-down skew.

1 files changed, 68 insertions, 40 deletions

diff --git a/R/tranche_functions.R b/R/tranche_functions.R
index 387a899..39888d9 100644
--- a/R/tranche_functions.R
+++ b/R/tranche_functions.R
@@ -657,32 +657,44 @@ BClossdistC <- function(defaultprob, issuerweights, recov, rho, Z, w,
     return(list(L=r$L,R=r$R))

 }

 

-BCtranche.legs <- function(index, K, rho){

+BCtranche.legs <- function(index, K, rho, complement=FALSE){

     ## computes the protection leg and couponleg of a 0-K tranche

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

-    return(list(cl=tranche.cl(dist$L, dist$R, index$cs, 0, K), pl=tranche.pl(dist$L, index$cs, 0, K)))

+    ## if complement==TRUE, computes the protection leg and coupon leg of a K-1 tranche

+    if((K==0 && !complement) || (K==1 && complement)){

+        return(list(cl=0, pl=0))

+    }else if((K==1 && !complement) || (K==0 && complement)){

+        return(BCindex.pv(index))

+    }else{

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

+        if(complement){

+            return(list(cl=tranche.cl(dist$L, dist$R, index$cs, K, 1),

+                        pl=tranche.pl(dist$L, index$cs, K, 1)))

+        }else{

+            return(list(cl=tranche.cl(dist$L, dist$R, index$cs, 0, K),

+                        pl=tranche.pl(dist$L, index$cs, 0, K)))

+        }

+    }

 }

 

-BCtranche.pv <- function(index, protection=FALSE){

+BCtranche.pv <- function(index, protection=FALSE, complement=FALSE){

     ## computes the protection leg, couponleg, and bond price of a tranche

     ## in the base correlation setting

-

-    pl <- rep(0, length(index$rho)-1)

-    cl <- rep(0, length(index$rho)-1)

-    for(i in 2:(length(index$rho)-1)){

-        temp <- BCtranche.legs(index, index$K[i], index$rho[i])

+    ## if complement=FALSE compute the pvs starting from 0 (bottom-up skew)

+    ## if complement=TRUE compute the pvs starting from 1 (top-down skew)

+    pl <- rep(0, length(index$rho))

+    cl <- rep(0, length(index$rho))

+    for(i in seq_along(index$rho)){

+        temp <- BCtranche.legs(index, index$K[i], index$rho[i], complement)

         pl[i] <- temp$pl

         cl[i] <- temp$cl

     }

     dK <- diff(index$K)

-    plvec <- diff(pl)/dK[-length(dK)]

-    clvec <- diff(cl)/dK[-length(dK)]*index$tranche.running[-length(index$tranche.running)]

-    ## compute the supersenior as the left over

-    temp <- indexpv(index, tradedate = tradedate, clean = FALSE)

-    indexpl <- temp$pl

-    indexcl <- temp$cl/index$quotes$spread

-    plvec <- c(plvec, -(indexpl+pl[4])/dK[length(dK)])

-    clvec <- c(clvec, (indexcl-cl[4])*index$tranche.running[length(index$tranche.running)]/dK[length(dK)])

+    plvec <- diff(pl)/dK

+    clvec <- diff(cl)/dK*index$tranche.running

+    if(complement){

+        plvec <- -plvec

+        clvec <- -clvec

+    }

     if(protection){

         bp <- -plvec-clvec

     }else{

@@ -698,8 +710,8 @@ adjust.skew <- function(index1, index2, method="ATM"){
     #    method="TLP", do tranche loss proportion mapping

     #    method="PM", do probability matching

 

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

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

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

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

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

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

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

@@ -715,7 +727,7 @@ adjust.skew <- function(index1, index2, method="ATM"){
     skew <- function(x){

         #we cap the correlation at 0.99

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

-        return(min(f(x), 0.99))

+        return(pmin(f(x), 0.99))

     }

     if(method=="ATM"){

         K1eq <- el1/el2 * K2

@@ -730,14 +742,14 @@ adjust.skew <- function(index1, index2, method="ATM"){
         }

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

         K1eq <- c()

-        m <- max(K2) + 0.3

+        m <- max(K2) + 0.25

         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))

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

 }

 

 theta.adjust.skew <- function(index, shortened=4, method="ATM"){

@@ -749,28 +761,28 @@ theta.adjust.skew <- function(index, shortened=4, method="ATM"){
     return(adjust.skew(index, indexshort, method))

 }

 

-BCtranche.theta <- function(index, tradedate=Sys.Date(), shortened=4){

-    temp <- BCtranche.pv(index)

-    rho.adj <- theta.adjust.skew(index, shortened)

+BCtranche.theta <- function(index, shortened=4, complement=FALSE, method="ATM"){

+    temp <- BCtranche.pv(index, complement=FALSE)

+    rho.adj <- theta.adjust.skew(index, shortened, method)

     if(any(rho.adj[-c(1, length(rho.adj))]<=0)){

         print("probable inverted skew: no adjustment")

     }else{

         index$rho <- rho.adj

     }

-    N <- nrow(index$cs)-shortened

+    N <- nrow(index$cs) - shortened

     index$cs <- index$cs[1:N,]

     index$defaultprob <- index$defaultprob[,1:N]

-    temp2 <- BCtranche.pv(index)

-    temp3 <- BCtranche.delta(index, tradedate)

+    temp2 <- BCtranche.pv(index, complement=complement)

+    temp3 <- BCtranche.delta(index, complement=complement)

     return(list(theta=temp2$bp-temp$bp+index$tranche.running,

                 delta=temp3$delta))

 }

 

-BCtranche.delta <- function(index, tradedate = Sys.Date()){

+BCtranche.delta <- function(index, complement=FALSE){

     ## computes the tranche delta (on current notional) by doing a proportional

     ## blip of all the curves

-    ## if K2==1, then computes the delta using the lower attachment only

-    ## this makes sense for bottom-up skews

+    ## if complement is False, then computes deltas bottom-up

+    ## if complement is True, then computes deltas top-down

     eps <- 1e-4

     index$Ngrid <- 301 ## for gamma computations we need all the precision we can get

     ## we build a lit of 4 indices with various shocks

@@ -784,13 +796,11 @@ BCtranche.delta <- function(index, tradedate = Sys.Date()){
             return(newindex)

         }

     })

-

     bp <- matrix(0, length(index$K)-1, length(index.list))

     indexbp <- rep(0, length(index.list))

     for(j in seq_along(index.list)){

-        temp <- BCtranche.pv(index.list[[j]])

-        indexbp[j] <- indexpv(index.list[[j]], tradedate = tradedate, clean = FALSE)$bp

-        bp[,j] <- temp$bp

+        indexbp[j] <- BCindex.pv(index.list[[j]])$bp

+        bp[,j] <- BCtranche.pv(index.list[[j]], complement=complement)$bp

     }

 

     deltas <- (bp[,2]-bp[,3])/(indexbp[2]-indexbp[3])*tranche.factor(index)/index$factor

@@ -800,11 +810,11 @@ BCtranche.delta <- function(index, tradedate = Sys.Date()){
     return( list(deltas=deltas, gammas=gammas) )

 }

 

-BCtranche.corr01 <- function(index, eps=0.01){

+BCtranche.corr01 <- function(index, eps=0.01, complement=FALSE){

     ##does a parallel shift of the skew and computes the change in pv

-    before <- BCtranche.pv(index)

+    before <- BCtranche.pv(index, complement=complement)

     index$rho[-1] <- index$rho[-1]+eps

-    after <- BCtranche.pv(index)

+    after <- BCtranche.pv(index, complement=complement)

     return(after$bp-before$bp)

 }

 

@@ -817,18 +827,36 @@ EL <- function(index, discounted=TRUE, shortened=0){
     Ncol <- ncol(index$defaultprob)-shortened

     ELvec <- as.numeric(crossprod(index$issuerweights * (1-index$recov), index$defaultprob[,1:Ncol]))

     if(!discounted){

-       return( diff(c(0, ELvec)) )

+       return( ELvec[length(ELvec)] )

    }else{

        return( sum(index$cs$df[1:Ncol]*diff(c(0, ELvec))) )

    }

 }

 

+BCindex.pv <- function(index, discounted=TRUE, shortened=0){

+    Ncol <- ncol(index$defaultprob)-shortened

+    ELvec <- as.numeric(crossprod(index$issuerweights * (1-index$recov), index$defaultprob[,1:Ncol]))

+    size <- 1-as.numeric(crossprod(index$issuerweights, index$defaultprob[,1:Ncol]))

+    sizeadj <- 0.5*(c(1, size[-length(size)])+size)

+    if(!discounted){

+        pl <- -ELvec[length(ELvec)]

+        cl <- as.numeric(crossprod(index$cs$coupons, sizeadj))

+        bp <- 1+cl+pl

+    }else{

+        pl <-  -sum(index$cs$df[1:Ncol]* diff(c(0, ELvec)))

+        cl <- as.numeric(crossprod(index$cs$coupons, sizeadj * index$cs$df[1:Ncol] ))

+        bp <- 1+cl+pl

+    }

+    bp <- 1+cl*index$quotes$spread+pl

+    return(list(pl=pl, cl=cl, bp=bp))

+}

+

 ELtrunc <- function(index, K, rho){

     ## computes the expected loss of a portfolio below strike K

     ## could be written faster by using a truncated version of lossdist

     ## index should be a list with issuerweights, recov, defaultprob and cs parameters

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

-    return( -tranche.pl(dist$L, index$cs, 0, K) )

+    return( -tranche.pl(dist$L, index$cs, 0, K))

 }

 

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