diff options
| -rw-r--r-- | calibrate_tranches.R | 87 | ||||
| -rw-r--r-- | cds_functions_generic.R | 11 | ||||
| -rw-r--r-- | interpweights.R | 4 | ||||
| -rw-r--r-- | tranche_functions.R | 30 |
4 files changed, 104 insertions, 28 deletions
diff --git a/calibrate_tranches.R b/calibrate_tranches.R index 18e2621f..c1f44a58 100644 --- a/calibrate_tranches.R +++ b/calibrate_tranches.R @@ -57,39 +57,45 @@ for(i in 1:nrow(nondefaulted)){ SC@curve <- cdshazardrate(quotes, nondefaulted$recovery[i]/100)
hy17portfolio <- c(hy17portfolio, SC)
}
+
issuerweights <- rep(1/length(hy17portfolio), length(hy17portfolio))
-hy17$indexref <- 1.025
+hy17$indexref <- 1.02
hy17portfolio.tweaked <- tweakcurves(hy17portfolio, hy17)
SurvProb <- SPmatrix(hy17portfolio.tweaked, hy17)
## load common parameters
K <- c(0, 0.15, 0.25, 0.35, 1)
Kmodified <- adjust.attachments(K, hy17$loss, hy17$factor)
-tranche.upf <- c(46.6875, 92.625, 105.375, 114.562)
+tranche.upf <- c(44.875, 91.75, 104.8125, 114.3125)
tranche.running <- c(0.05, 0.05, 0.05, 0.05)
-lu <- 0.01
+Ngrid <- 2*nrow(nondefaulted)+1
recov <- sapply(hy17portfolio.tweaked, attr, "recovery")
cs <- couponSchedule(nextIMMDate(today()), hy17$maturity,"Q", "FIXED", 0.05, 0)
## calibrate the tranches using base correlation
rhovec <- c()
f <- function(rho, ...){
- temp <- BClossdistC(SurvProb, issuerweights, recov, rho, lu, 100)
- return( abs(tranche.upf[i-1]-1/(Kmodified[i]-Kmodified[i-1])*
- (tranche.bp(temp$L, temp$R, cs, 0, Kmodified[i])*Kmodified[i]-
- tranche.bp(oldtemp$L, oldtemp$R, cs, 0, Kmodified[i-1])*Kmodified[i-1])) )
+ temp <- BClossdistC(SurvProb, issuerweights, recov, rho, Ngrid)
+ bp <- 100*(1+1/(Kmodified[i]-Kmodified[i-1]) *
+ (tranche.pv(temp$L, temp$R, cs, 0, Kmodified[i], Ngrid) -
+ tranche.pv(oldtemp$L, oldtemp$R, cs, 0, Kmodified[i-1], Ngrid)))
+ return( abs(tranche.upf[i-1]-bp))
}
for(i in 2:length(Kmodified)){
rho <- optimize(f, interval=c(0,1),
SurvProb, issuerweights, recov, lu, tranche.upf, Kmodified, cs, oldtemp)$minimum
- oldtemp <- BClossdistC(SurvProb, issuerweights, recov, rho, lu)
+ oldtemp <- BClossdistC(SurvProb, issuerweights, recov, rho, Ngrid)
rhovec <- c(rhovec, rho)
}
+deltas <- c()
+for(i in 2:5){
+ deltas <- c(deltas, BCtranche.delta(hy17portfolio.tweaked, hy17, 0.05, K[i-1], K[i], rhovec[i-1], rhovec[i], Ngrid))
+}
-#calibrate by modifying the factor distribution
+##calibrate by modifying the factor distribution
bottomup <- 1:3
topdown <- 2:4
n.int <- 100
@@ -104,15 +110,15 @@ p <- defaultprob rho <- 0.45
clusterExport(cl, list("shockprob", "issuerweights", "rho", "Z", "lossrecovdist.term",
- "lossrecovdist", "lossdistribC", "lu",
- "tranche.bpvec", "tranche.bp", "tranche.pl", "tranche.cl",
+ "lossrecovdist", "lossdistribC", "Ngrid",
+ "tranche.pvvec", "tranche.pv", "tranche.pl", "tranche.cl",
"trancheloss", "trancherecov", "pos", "Kmodified", "cs"))
-
+## TODO: investigate if this is the right thing w.r.t recovery
parf <- function(i){
pshocked <- apply(p, 2, shockprob, rho=rho, Z=Z[i])
S <- 1 - Rstoch[i,,]
- dist <- lossrecovdist.term(pshocked, 0, issuerweights, S, lu)
- return( tranche.bpvec(Kmodified, dist$L, dist$R, cs))
+ dist <- lossrecovdist.term(pshocked, 0, issuerweights, S, Ngrid)
+ return( tranche.pvvec(Kmodified, dist$L, dist$R, cs))
}
for(l in 1:100){
@@ -122,10 +128,12 @@ for(l in 1:100){ Rstoch[,i,t] <- stochasticrecov(recov[i], 0, Z, w.mod, rho, defaultprob[i,t], p[i,t])
}
}
+
clusterExport(cl, list("Rstoch", "p"))
result <- parSapply(cl, 1:n.int, parf)
## solve the optimization problem
- program <- KLfit(result[topdown,], w, tranche.upf[topdown])
+ program <- KLfit(100*(result[bottomup,]+1), w, tranche.upf[bottomup])
+
err <- 0
for(i in 1:n.credit){
@@ -133,15 +141,54 @@ for(l in 1:100){ err <- err + abs(crossprod(shockprob(p[i,j], rho, Z), program$weight) - defaultprob[i,j])
}
}
+ errvec <- c(errvec, err)
## update the new probabilities
- for(i in 1:n.credit){
- for(j in 1:ncol(p)){
- p[i,j] <- fit.prob(Z, program$weight, rho, defaultprob[i,j])
- }
- }
+ p <- MFupdate.prob(Z, program.weight, rho, defaultprob)
errvec <- c(errvec, err)
w.mod <- program$weight
cat(err,"\n")
}
+clusterExport(cl, list("shockprob", "issuerweights", "rho", "Z", "lossrecovdist.term",
+ "lossrecovdist", "lossdistribC", "Ngrid",
+ "tranche.pvvec", "tranche.pv", "tranche.pl", "tranche.cl",
+ "trancheloss", "trancherecov", "pos", "Kmodified", "cs"))
+
+MFtranche.pv <- function(cl, cs, w, rho, defaultprob, p, issuerweights,
+ Ngrid=length(issuerweights)+1, Kmodified, n.int=100){
+ ## 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)){
+ for(i in 1:n.credit){
+ Rstoch[,i,t] <- stochasticrecov(recov[i], 0, Z, w, rho, defaultprob[i,t], p[i,t])
+ }
+ }
+ parf <- function(i){
+ pshocked <- apply(p, 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))
+ }
+ clusterExport(cl, list("Rstoch", "p"))
+ result <- parSapply(cl, 1:n.int, parf)
+ return( 100*(1+result%*%w.mod) )
+}
+
+## computes deltas
+newportf <- hy17portfolio.tweaked
+eps <- 1e-4
+for(i in 1:length(newportf)){
+ newportf[[i]]@curve@hazardrates <- hy17portfolio.tweaked[[i]]@curve@hazardrates * (1 + eps)
+}
+SurvProb2 <- SPmatrix(newportf, hy17)
+p2 <- MFupdate.prob(Z, w.mod, rho, 1-SurvProb2)
+dPVtranches <- MFtranche.pv(cl, cs, w.mod, rho, 1-SurvProb2, p2, issuerweights) - MFtranche.pv(cl, cs, w.mod, rho, defaultprob, p, issuerweights)
+dPVindex <- indexpv(newportf, hy17)-indexpv(hy17portfolio.tweaked, hy17)
+MFdeltas <- dPVtranches/dPVindex
+
+#global deltas
+PVtranches <- MFtranche.pv(cl, cs, w.mod, rho, defaultprob, p, issuerweights)
+PVindex <-
diff --git a/cds_functions_generic.R b/cds_functions_generic.R index 330920b2..9183b3e1 100644 --- a/cds_functions_generic.R +++ b/cds_functions_generic.R @@ -483,18 +483,21 @@ bondhazardrate.shaped <- function(collateral, shape, R=0.4, alpha=0.25, beta=15) indexpv <- function(portfolio, index, epsilon=0){
## computes the intrinsic index pv of a portfolio of cds
- r <- rep(0, length(portfolio))
+ pl <- rep(0, length(portfolio))
+ cl <- rep(0, length(portfolio))
cs <- couponSchedule(nextIMMDate(today()), index$maturity, "Q", "FIXED", index$coupon)
for(i in 1:length(portfolio)){
if(epsilon!=0){
tweakedcurve <- portfolio[[i]]@curve
tweakedcurve@hazardrates <- tweakedcurve@hazardrates * (1 + epsilon)
- r[i] <- cdspv(cs, tweakedcurve, portfolio[[i]]@recovery)
+ cl[i] <- couponleg(cs, tweakedcurve, portfolio[[i]]@recovery)
+ pl[i] <- defaultleg(cs, tweakedcurve, portfolio[[i]]@recovery)
}else{
- r[i] <- cdspv(cs, portfolio[[i]]@curve, portfolio[[i]]@recovery)
+ cl[i] <- couponleg(cs, portfolio[[i]]@curve, portfolio[[i]]@recovery)
+ pl[i] <- defaultleg(cs, portfolio[[i]]@curve, portfolio[[i]]@recovery)
}
}
- return( 1+mean(r) )
+ return( list(cl=mean(cl), pl=mean(pl), bp=1+pl-cl))
}
indexduration <- function(portfolio, index){
diff --git a/interpweights.R b/interpweights.R index 513b2a31..03de58d7 100644 --- a/interpweights.R +++ b/interpweights.R @@ -15,7 +15,7 @@ adjust_weights <- function(weights, scenario, epsilon){ interpweights(weights,scenario,adjust_scenario(scenario,epsilon))
}
-obj <- function(epsilon, vecpv, prob,support, cte){
+obj <- function(epsilon, vecpv, prob, support, cte){
newprob <- adjust_weights(prob, support, epsilon)
return( 1 - crossprod(newprob, vecpv) - cte)
}
@@ -53,7 +53,7 @@ transformweightslike <- function(p1, v1, p2, v2, p, v){ r[i] <- inverse(P1,dP1,pomme[i])
}
return(r)
-}
+}
clipw <- function(x){
write(x,file="clipboard",sep="\n")
diff --git a/tranche_functions.R b/tranche_functions.R index 3c41d45f..b1d11b13 100644 --- a/tranche_functions.R +++ b/tranche_functions.R @@ -1,5 +1,17 @@ library(statmod)
+## todo:
+## -investigate other ways to interpolate the random severities on the grid
+## I'm thinking that at eah severity that we add to the distribution, round it down
+## and keep track of the missing mass: namely if X_i=S_i w.p p_i, then add
+## X_i=lu*floor(S_i/lu) with probability p_i and propagate
+## X_{i+1}=S_{i+1}+(S_i-lu*floor(S_i/lu)) with the right probability
+## - investigate truncated distributions more (need to compute loss and recov distribution
+## separately, for the 0-10 equity tranche, we need the loss on the 0-0.1 support and
+## recovery with 0.1-1 support, so it's not clear that there is a big gain.
+## - do the correlation adjustments when computing the deltas since it seems to be
+## the market standard
+
lossdistrib <- function(p){
## basic recursive algorithm of Andersen, Sidenius and Basu
n <- length(p)
@@ -310,6 +322,8 @@ trancherecov <- function(R, K1, K2){ tranche.cl <- function(L, R, cs, K1, K2, Ngrid=nrow(L), scaled=FALSE){
## computes the couponleg of a tranche
## if scaled is TRUE, scale it by the size of the tranche (K2-K1)
+ ## can make use of the fact that the loss and recov distribution are
+ ## truncated (in that case nrow(L) != Ngrid
if(K1==K2){
return( 0 )
}else{
@@ -398,7 +412,7 @@ BClossdistC <- function(SurvProb, issuerweights, recov, rho, return(list(L=r$L,R=r$R))
}
-BCtranche.pv <- function(portfolio, index, coupon, K1, K2, rho1, rho2, N=101){
+BCtranche.pv <- function(portfolio, index, coupon, K1, K2, rho1, rho2, N=length(portfolio)+1){
## computes the protection leg, couponleg, and bond price of a tranche
## in the base correlation setting
if(K1==0){
@@ -424,7 +438,7 @@ BCtranche.pv <- function(portfolio, index, coupon, K1, K2, rho1, rho2, N=101){ bp=100*(1+(pl2-pl1+cl2-cl1)/dK)))
}
-BCtranche.delta <- function(portfolio, index, coupon, K1, K2, rho1, rho2, N=101){
+BCtranche.delta <- function(portfolio, index, coupon, K1, K2, rho1, rho2, N=length(portolio)+1){
## 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
@@ -469,3 +483,15 @@ delta.factor <- function(K1, K2, index){ -adjust.attachments(K1, index$loss, index$factor))/(K2-K1)
return( factor )
}
+
+MFupdate.prob <- function(Z, w, rho, defaultprob){
+ ## update the probabilites based on a non gaussian factor
+ ## distribution so that the pv of the cds stays the same.
+ p <- matrix(0, nrow(defaultprob), ncol(defaultprob))
+ for(i in 1:nrow(defaultprob)){
+ for(j in 1:ncol(defaultprob)){
+ p[i,j] <- fit.prob(Z, program$weight, rho, defaultprob[i,j])
+ }
+ }
+ return( p )
+}
|