From 06f6d369b27e374efc141a90a157922696364c22 Mon Sep 17 00:00:00 2001 From: Guillaume Horel Date: Tue, 19 Aug 2014 17:20:02 -0400 Subject: 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. --- R/tranche_functions.R | 108 +++++++++++++++++++++++++++++++------------------- 1 file changed, 68 insertions(+), 40 deletions(-) (limited to 'R/tranche_functions.R') 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){ -- cgit v1.2.3-70-g09d2