diff options
| -rw-r--r-- | R/tranche_functions.R | 158 |
1 files changed, 82 insertions, 76 deletions
diff --git a/R/tranche_functions.R b/R/tranche_functions.R index 7a89a570..b33ec339 100644 --- a/R/tranche_functions.R +++ b/R/tranche_functions.R @@ -116,15 +116,16 @@ adjust.attachments <- function(K, losstodate, factor){ return( pmin(pmax((K-losstodate)/factor, 0),1) ) } -BCtranche.legs <- function(index, K, rho, complement=FALSE){ +BCtranche.legs <- function(index, K, rho, complement=FALSE) { ## computes the protection leg and couponleg of a 0-K tranche ## 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)) { + } 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) + } 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))) @@ -142,7 +143,7 @@ BCtranche.pv <- function(index, protection=FALSE, complement=FALSE){ ## 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)){ + 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 @@ -150,38 +151,38 @@ BCtranche.pv <- function(index, protection=FALSE, complement=FALSE){ dK <- diff(index$K) plvec <- diff(pl)/dK clvec <- diff(cl)/dK*index$tranches$running - if(complement){ + if(complement) { plvec <- -plvec clvec <- -clvec } - if(protection){ - bp <- -plvec-clvec + if(protection) { + bp <- - plvec - clvec }else{ - bp <- 1+plvec+clvec + bp <- 1 + plvec + clvec } return(list(pl=plvec, cl=clvec, bp=bp)) } -MFtranche.pv <- function(index, dist, protection=FALSE){ - n.tranches <- length(index$K)-1 +MFtranche.pv <- function(index, dist, protection=FALSE) { + n.tranches <- length(index$K) - 1 pl <- rep(0, n.tranches) cl <- rep(0, n.tranches) - for(i in seq.int(n.tranches)){ + for(i in seq.int(n.tranches)) { pl[i] <- tranche.pl(dist$L, index$cs, index$K[i], index$K[i+1]) cl[i] <- tranche.cl(dist$L, dist$R, index$cs, index$K[i], index$K[i+1]) } dK <- diff(index$K) plvec <- pl/dK clvec <- cl/dK*index$tranches$running - if(protection){ + if(protection) { bp <- -plvec-clvec - }else{ + } else { bp <- 1+plvec+clvec } return(list(pl=plvec, cl=clvec, bp=bp)) } -adjust.skew <- function(index1, index2, method=c("ATM", "TLP", "PM")){ +adjust.skew <- function(index1, index2, method=c("ATM", "TLP", "PM")) { #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 @@ -191,43 +192,43 @@ adjust.skew <- function(index1, index2, method=c("ATM", "TLP", "PM")){ 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){ + aux <- function(x, index1, el1, skew, index2, el2, K2) { newrho <- cap(skew(x)) return(abs(ELtrunc(index1, x, newrho)/el1- ELtrunc(index2, K2, newrho)/el2)) } - aux2 <- function(x, index1, skew, index2, K2){ + aux2 <- function(x, index1, skew, index2, K2) { newrho <- cap(skew(x)) return(abs(log(Probtrunc(index1, x, newrho))- log(Probtrunc(index2, K2, newrho)))) } - if(method %in% c("ATM", "TLP")){ + if(method %in% c("ATM", "TLP")) { el1 <- EL(index1) el2 <- EL(index2) } skew <- splinefun(K1, index1$rho[-c(1, length(index1$rho))], "natural") - cap <- function(x){ + cap <- function(x) { pmax(pmin(x, 0.99), 0.01) } - if(method=="ATM"){ + if(method=="ATM") { K1eq <- el1/el2 * K2 - }else if(method == "TLP"){ + } else if(method == "TLP") { K1eq <- c() m <- max(K2) + 0.3 - for(K2val in K2){ + for(K2val in K2) { 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"){ + } else if (method=="PM") { K1eq <- c() m <- max(K2) + 0.25 - for(K2val in K2){ + for(K2val in K2) { prog <- optimize(aux2, interval=c(K2val*0.1, K2val*1.8), index1=index1, skew=skew, index2=index2, K2=K2val) K1eq <- c(K1eq, prog$minimum) @@ -252,7 +253,7 @@ BCtranche.theta <- function(index, shortened=4, complement=FALSE, method="ATM") fw.delta=temp3$delta)) } -BCtranche.delta <- function(index, complement=FALSE){ +BCtranche.delta <- function(index, complement=FALSE) { ## computes the tranche delta (on current notional) by doing a proportional ## blip of all the curves ## if complement is False, then computes deltas bottom-up @@ -260,10 +261,10 @@ BCtranche.delta <- function(index, complement=FALSE){ eps <- 1e-4 index$N <- 301 ## for gamma computations we need all the precision we can get ## we build a lit of 4 indices with various shocks - index.list <- lapply(c(0, eps, -eps, 2*eps), function(x){ - if(x==0){ + index.list <- lapply(c(0, eps, -eps, 2*eps), function(x) { + if(x==0) { return(index) - }else{ + } else { newindex <- index newindex$portfolio <- tweakportfolio(newindex$portfolio, x) newindex$defaultprob <- 1 - SPmatrix(newindex$portfolio, index$cs$dates) @@ -272,7 +273,7 @@ BCtranche.delta <- function(index, complement=FALSE){ }) bp <- matrix(0, length(index$K)-1, length(index.list)) indexbp <- rep(0, length(index.list)) - for(j in seq_along(index.list)){ + for(j in seq_along(index.list)) { indexbp[j] <- BCindex.pv(index.list[[j]])$bp bp[,j] <- BCtranche.pv(index.list[[j]], complement=complement)$bp } @@ -292,10 +293,10 @@ MFtranche.delta <- function(index){ 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 - index.list <- lapply(c(0, eps, -eps, 2*eps), function(x){ - if(x==0){ + index.list <- lapply(c(0, eps, -eps, 2*eps), function(x) { + if(x==0) { return(index) - }else{ + } else { newindex <- index newindex$portfolio <- tweakportfolio(newindex$portfolio, x) newindex$defaultprob <- 1 - SPmatrix(newindex$portfolio, length(index$cs$dates)) @@ -304,7 +305,7 @@ MFtranche.delta <- function(index){ }) bp <- matrix(0, length(index$K)-1, length(index.list)) indexbp <- rep(0, length(index.list)) - for(j in seq_along(index.list)){ + for(j in seq_along(index.list)) { indexbp[j] <- BCindex.pv(index.list[[j]])$bp dist <- MFdist(index.list[[j]]) bp[,j] <- BCtranche.pv(index.list[[j]], dist) @@ -317,7 +318,7 @@ MFtranche.delta <- function(index){ return( list(deltas=deltas, gammas=gammas) ) } -BCtranche.corr01 <- function(index, eps=0.01, complement=FALSE){ +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, complement=complement) index$rho[-1] <- index$rho[-1]^(1-eps) @@ -325,27 +326,27 @@ BCtranche.corr01 <- function(index, eps=0.01, complement=FALSE){ return(after$bp-before$bp) } -BCtranche.VaR <- function(index, skew.shocks, complement=FALSE){ +BCtranche.VaR <- function(index, skew.shocks, complement=FALSE) { before <- BCtranche.pv(index, complement=complement) n <- length(index$rho) r <- matrix(0, nrow(skew.shocks), n-1) logskew <- log(index$rho[-c(1,n)]) - for(i in 1:nrow(skew.shocks)){ - index$rho[-c(1,n)] <- exp(logskew*(1+skew.shocks[i,])) + for(i in 1:nrow(skew.shocks)) { + index$rho[-c(1,n)] <- exp(logskew * (1 + skew.shocks[i,])) after <- BCtranche.pv(index, complement=complement) - r[i,] <- before$bp-after$bp + r[i,] <- before$bp - after$bp } return( r ) } -EL <- function(index, discounted=TRUE, shortened=0){ +EL <- function(index, discounted=TRUE, shortened=0) { ## computes the expected loss of a portfolio (time discounted if discounted is TRUE) ## given the default curves and recovery ## should be very close to the protection leg of the portfolio of cds ## index should be a list with issuerweights, recov, defaultprob and cs parameters ## shortened: number of quarters to shorten the maturity by Ncol <- ncol(index$defaultprob) - if(is.null(Ncol) && shortened==0){ + if(is.null(Ncol) && shortened==0) { DP <- index$defaultprob df <- index$cs$df }else{ @@ -360,40 +361,40 @@ EL <- function(index, discounted=TRUE, shortened=0){ } } -BCindex.pv <- function(index, discounted=TRUE, shortened=0){ +BCindex.pv <- function(index, discounted=TRUE, shortened=0) { Ncol <- ncol(index$defaultprob) - if(is.null(Ncol) && shortened==0){ + if(is.null(Ncol) && shortened == 0) { DP <- index$defaultprob Ncol <- 1 - }else{ + } else { DP <- index$defaultprob[,1:(Ncol-shortened)] } ELvec <- as.numeric(crossprod(index$issuerweights * (1-index$recov), DP)) - size <- 1-as.numeric(crossprod(index$issuerweights, DP)) + size <- 1 - as.numeric(crossprod(index$issuerweights, DP)) sizeadj <- 0.5*(c(1, size[-length(size)])+size) - if(!discounted){ + if(!discounted) { pl <- -ELvec[length(ELvec)] cl <- as.numeric(crossprod(index$cs$coupons[1:Ncol], sizeadj)) - bp <- 1+cl+pl - }else{ + } else { pl <- -sum(index$cs$df[1:Ncol]* diff(c(0, ELvec))) cl <- as.numeric(crossprod(index$cs$coupons[1:Ncol], sizeadj * index$cs$df[1:Ncol] )) - bp <- 1+cl+pl } - bp <- 1+cl*index$quotes$spread+pl + bp <- 1 + cl*index$quotes$spread+pl return(list(pl=pl, cl=cl, bp=bp)) } -ELtrunc <- function(index, K, rho){ +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) + dist <- BClossdistC(index$defaultprob, index$issuerweights, + index$recov, rho, index$Z, index$w, index$N) 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) +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") @@ -423,26 +424,28 @@ MFupdate.prob <- function(Z, w, rho, defaultprob, useC = TRUE){ ## distribution so that the pv of the cds stays the same. p <- matrix(0, nrow(defaultprob), ncol(defaultprob)) fit.prob <- if(useC) fit.probC else fit.prob - for(i in 1:nrow(defaultprob)){ - for(j in 1:ncol(defaultprob)){ + for(i in 1:nrow(defaultprob)) { + for(j in 1:ncol(defaultprob)) { p[i,j] <- fit.prob(Z, w, rho[i], defaultprob[i,j]) } } return( p ) } -MFlossrecovdist.prepay <- function(w, Z, rho, defaultprob, defaultprobmod, prepayprob, prepayprobmod, - issuerweights, recov, Ngrid=2*length(issuerweights)+1, defaultflag=FALSE){ +MFlossrecovdist.prepay <- function(w, Z, rho, defaultprob, defaultprobmod, + prepayprob, prepayprobmod, issuerweights, + recov, Ngrid=2*length(issuerweights)+1, defaultflag=FALSE){ ## computes the loss and recovery distribution using the modified factor distribution n.credit <- length(issuerweights) n.int <- length(w) Rstoch <- array(0, dim=c(n.int, n.credit, ncol(defaultprob))) - for(t in 1:ncol(defaultprob)){ - for(i in 1:n.credit){ - Rstoch[,i,t] <- stochasticrecov(recov[i], 0, Z, w, rho, defaultprob[i,t], defaultprobmod[i,t]) + for(t in 1:ncol(defaultprob)) { + for(i in 1:n.credit) { + Rstoch[,i,t] <- stochasticrecov(recov[i], 0, Z, w, rho, + defaultprob[i,t], defaultprobmod[i,t]) } } - parf <- function(i){ + parf <- function(i) { dpshocked <- apply(defaultprobmod, 2, shockprob, rho=rho, Z=Z[i]) ppshocked <- apply(prepayprobmod, 2, shockprob, rho=rho, Z=-Z[i]) S <- 1 - Rstoch[i,,] @@ -450,7 +453,7 @@ MFlossrecovdist.prepay <- function(w, Z, rho, defaultprob, defaultprobmod, prepa } L <- matrix(0, Ngrid, ncol(defaultprob)) R <- matrix(0, Ngrid, ncol(defaultprob)) - for(i in 1:length(w)){ + for(i in 1:length(w)) { dist <- parf(i) L <- L + dist$L * w[i] R <- R + dist$R * w[i] @@ -458,8 +461,10 @@ MFlossrecovdist.prepay <- function(w, Z, rho, defaultprob, defaultprobmod, prepa return( list(L=L, R=R) ) } -MFlossdist.joint <- function(cl, w, Z, rho, defaultprob, defaultprobmod, issuerweights, recov, - Ngrid=2*length(issuerweights)+1, defaultflag=FALSE){ +MFlossdist.joint <- function(cl, w, Z, rho, defaultprob, defaultprobmod, + issuerweights, recov, + Ngrid=2*length(issuerweights)+1, + defaultflag=FALSE) { ## rowSums(Q) is the default/loss distribution depending if ## defaultflag is TRUE or FALSE (default setting is FALSE) ## colSums(Q) is the recovery distribution @@ -469,12 +474,13 @@ MFlossdist.joint <- function(cl, w, Z, rho, defaultprob, defaultprobmod, issuerw n.credit <- length(issuerweights) n.int <- lenth(w) Rstoch <- array(0, dim=c(n.int, n.credit, ncol(defaultprob))) - for(t in 1:ncol(defaultprob)){ + for(t in 1:ncol(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] <- stochasticrecov(recov[i], 0, Z, w, rho, + defaultprob[i,t], defaultprobmod[i,t]) } } - parf <- function(i){ + parf <- function(i) { pshocked <- apply(defaultprobmod, 2, shockprob, rho=rho, Z=Z[i]) S <- 1 - Rstoch[i,,] dist <- lossrecovdist.joint.term(pshocked, 0, issuerweights, S, Ngrid, defaultflag) @@ -484,7 +490,7 @@ MFlossdist.joint <- function(cl, w, Z, rho, defaultprob, defaultprobmod, issuerw temp <- parSapply(cl, 1:length(w), parf) clusterCall(cl, gc) Q <- array(0, dim=c(ncol(defaultprob), Ngrid, Ngrid)) - for(i in 1:length(w)){ + for(i in 1:length(w)) { Q <- Q + w[i]*array(temp[,i], dim=c(ncol(defaultprob), Ngrid, Ngrid)) } return( Q ) @@ -492,7 +498,7 @@ MFlossdist.joint <- function(cl, w, Z, rho, defaultprob, defaultprobmod, issuerw MFlossdist.prepay.joint <- function(w, Z, rho, defaultprob, defaultprobmod, prepayprob, prepayprobmod, issuerweights, recov, - Ngrid=2*length(issuerweights)+1, defaultflag=FALSE){ + Ngrid=2*length(issuerweights)+1, defaultflag=FALSE) { ## rowSums is the loss distribution ## colSums is the recovery distribution ## so that recovery is the y axis and L is the x axis @@ -502,14 +508,14 @@ MFlossdist.prepay.joint <- function(w, Z, rho, defaultprob, defaultprobmod, n.int <- length(w) Rstoch <- array(0, dim=c(n.credit, n.int, ncol(defaultprob))) - for(t in 1:ncol(defaultprob)){ + for(t in 1:ncol(defaultprob)) { for(i in 1:n.credit){ Rstoch[i,,t] <- stochasticrecovC(recov[i], 0, Z, w, rho[i], defaultprob[i,t], defaultprobmod[i,t]) } } Q <- array(0, dim=c(ncol(defaultprob), Ngrid, Ngrid)) - for(t in 1:ncol(defaultprob)){ + for(t in 1:ncol(defaultprob)) { S <- 1 - Rstoch[,,t] Q[t,,] <- lossdistC.prepay.jointZ(defaultprobmod[,t], prepayprobmod[,t], issuerweights, S, Ngrid, defaultflag, rho, Z, w) @@ -517,13 +523,13 @@ MFlossdist.prepay.joint <- function(w, Z, rho, defaultprob, defaultprobmod, return( Q ) } -MFrecovery <- function(index, defaultprobmod){ +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){ + for(t in 1:ncol(index$defaultprob)) { + for(i in 1:n.credit) { Rstoch[i,,t] <- stochasticrecovC(index$recov[i], 0, index$Z, index$w.mod, rho[i], index$defaultprob[i,t], defaultprobmod[i,t]) } @@ -531,7 +537,7 @@ MFrecovery <- function(index, defaultprobmod){ return( Rstoch ) } -MFlossdist <- function(index){ +MFlossdist <- function(index) { n.credit <- length(index$issuerweights) rho <- rep(0.45, n.credit) defaultprobmod <- MFupdate.prob(index$Z, index$w.mod, rho, index$defaultprob) @@ -542,7 +548,7 @@ MFlossdist <- function(index){ 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)){ + 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) |