aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--build_SC.R21
-rw-r--r--calibrate_tranches.R216
-rw-r--r--cds_functions_generic.R12
-rw-r--r--lossdistrib.c2
-rw-r--r--plot_distributions.R35
-rw-r--r--tranche_functions.R12
6 files changed, 72 insertions, 226 deletions
diff --git a/build_SC.R b/build_SC.R
index df7757ae..8565edec 100644
--- a/build_SC.R
+++ b/build_SC.R
@@ -310,25 +310,6 @@ buildSC.portfolio <- function(dealname, global.params, startdate=today()) {
## R.shocked [,i] <- stochasticrecov.simple(R, 0, Z[i], rho[j], g)
## }
-
-dpc <- new("defaultprepaycurve", dates=cs$dates, hazardrates=rep(0.05,length(cs$dates)),
- prepayrates=rep(0.01, length(cs$dates)))
-
-dc <- new("defaultcurve", dates=cs$dates, hazardrates=rep(0.05,length(cs$dates)))
-
-octagon8.collateral <- getcollateral("octagon8")
-octagon8.dealdata <- getdealdata("octagon8")
-pomme <- buildSC.portfolio(today(), octagon8.collateral, octagon8.dealdata)
-
-collateral <- octagon8.collateral[1,]
-cs <- couponSchedule(collateral$nextpaydate, collateral$maturity,
- collateral$frequency, collateral$fixedorfloat,
- collateral$grosscoupon*0.01, collateral$spread*0.01)
-
-k <- function(h, gamma = 15){
- 0.25*exp(-gamma * h)
-}
-
stonln1.portfolio <- buildSC.portfolio("stonln1", global.params)
A <- SPmatrix2(stonln1.portfolio$SC, getdealdata("stonln1"))
S <- 1 - sapply(stonln1.portfolio$SC, attr, "recov")
@@ -338,3 +319,5 @@ lu <- 0.01
test <- lossrecovdist(A$DP[,39], A$PP[,39], w, lu, useC=FALSE)
pomme2 <- lossdistrib3(A$DP[,39], w/length(w), lu)
+defaultprob <- A$DP[,39]
+prepayprob <- A$PP[,39]
diff --git a/calibrate_tranches.R b/calibrate_tranches.R
index 0528defe..2b684d8c 100644
--- a/calibrate_tranches.R
+++ b/calibrate_tranches.R
@@ -22,7 +22,6 @@ singlenames.data <- read.table(file="clipboard", sep="\t", header=T)
nondefaulted <- singlenames.data[!singlenames.data$ticker %in% hy17$defaulted,]
bps <- 1e-4
-hy17portfolio <- c()
cdsdates <- as.Date(character(0))
for(tenor in paste0(1:5, "y")){
cdsdates <- c(cdsdates, cdsMaturity(tenor))
@@ -47,6 +46,7 @@ for(tenor in paste0(1:5, "y")){
## return( cdshazardrate(quotes, nondefaulted$recovery[i]/100))
## }
+hy17portfolio <- c()
for(i in 1:nrow(nondefaulted)){
SC <- new("creditcurve",
recovery=nondefaulted$recovery[i]/100,
@@ -57,34 +57,34 @@ for(i in 1:nrow(nondefaulted)){
SC@curve <- cdshazardrate(quotes, nondefaulted$recovery[i]/100)
hy17portfolio <- c(hy17portfolio, SC)
}
-
-hy17$indexref <- 1.035
+issuerweights <- rep(1/length(hy17portfolio), length(hy17portfolio))
+hy17$indexref <- 1.0275
hy17portfolio.tweaked <- tweakcurves(hy17portfolio, hy17)
SurvProb <- SPmatrix(hy17portfolio.tweaked, hy17)
-
-## calibrate the tranches using base correlation
+## load common parameters
K <- c(0, 0.15, 0.25, 0.35, 1)
Kmodified <- adjust.attachments(K, hy17$loss, hy17$factor)
-tranche.upf <- c(49.625, 94.75, 107.125, 114.875)
+tranche.upf <- c(48, 93.125, 105.8125, 114.625)
tranche.running <- c(0.05, 0.05, 0.05, 0.05)
lu <- 0.01
recov <- sapply(hy17portfolio.tweaked, attr, "recovery")
-
-rhovec <- c()
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])) )
+}
for(i in 2:length(Kmodified)){
- f <- function(rho, ...){
- temp <- BClossdistC(SurvProb, 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])) )
- }
- rho <- optimize(f, SurvProb, recov, lu, tranche.upf, Kmodified, cs, oldtemp)$minimum
- oldtemp <- BClossdistC(SurvProb, rho, recov, lu)
+ rho <- optimize(f, interval=c(0,1),
+ SurvProb, issuerweights, recov, lu, tranche.upf, Kmodified, cs, oldtemp)$minimum
+ oldtemp <- BClossdistC(SurvProb, issuerweights, recov, rho, lu)
rhovec <- c(rhovec, rho)
}
@@ -102,7 +102,7 @@ defaultprob <- 1 - SurvProb
p <- defaultprob
rho <- 0.45
-clusterExport(cl, list("shockprob", "rho", "Z", "lossrecovdist.term",
+clusterExport(cl, list("shockprob", "issuerweights", "rho", "Z", "lossrecovdist.term",
"lossrecovdist", "lossdistribC", "lu",
"tranche.bpvec", "tranche.bp", "tranche.pl", "tranche.cl",
"trancheloss", "trancherecov", "pos", "Kmodified", "cs"))
@@ -110,7 +110,7 @@ clusterExport(cl, list("shockprob", "rho", "Z", "lossrecovdist.term",
parf <- function(i){
pshocked <- apply(p, 2, shockprob, rho=rho, Z=Z[i])
S <- 1 - Rstoch[i,,]
- dist <- lossrecovdist.term(pshocked, 0, S, lu)
+ dist <- lossrecovdist.term(pshocked, 0, issuerweights, S, lu)
return( tranche.bpvec(Kmodified, dist$L, dist$R, cs))
}
@@ -144,183 +144,3 @@ for(l in 1:100){
w.mod <- program$weight
cat(err,"\n")
}
-
-## some plots
-matplot(Z, cbind(w, w.mod), type="l", ylab="probability density",
- main="Factor distribution (Gaussian, and Market implied)")
-lossdist <- array(0, dim=c(1/lu+1, n.int))
-for(i in 1:n.int){
- pshocked <- sapply(p[,ncol(p)], shockprob, rho=rho, Z=Z[i])
- S <- 1 - Rstoch[i,,ncol(p)]
- lossdist[,i] <- lossrecovdist(pshocked, 0, S, lu)$L
-}
-
-lossdist.orig <- BClossdistC(SurvProb, rho, recov, lu)
-matplot(seq(0,1,0.01), cbind(lossdist.orig$L[,ncol(p)], lossdist%*%w.mod), type="l", xlab="loss percentage",
- ylab="probability density", main="market implied loss distribution")
-#3d surface of the loss distribution
-Rstoch <- array(0, dim=c(ncol(SurvProb), n.int, n.credit))
-for(t in 1:ncol(SurvProb)){
- for(i in 1:n.credit){
- Rstoch[t,,i] <- stochasticrecov(recov[i], 0, Z, w.mod, rho, defaultprob[i,t], p[i,t])
- }
-}
-lu <- 0.01
-clusterExport(cl, list("p", "shockprob", "rho", "Z", "lossdistribC.joint", "Rstoch", "lu"))
-
-parf <- function(i){
- pshocked <- apply(p, 2, shockprob, rho=rho, Z=Z[i])
- return( lossdistribC.joint(pshocked[,ncol(p)], 1-Rstoch[ncol(p),i,], lu) )
-}
-
-dist <- parSapply(cl, 1:n.int, parf)
-dist <- array(dist, dim=c(1/lu+1, 1/lu+1, 100))
-distw <- array(0, dim=c(1/lu+1, 1/lu+1))
-for(i in 1:n.int){
- distw <- distw+dist[,,i] * w.mod[i]
-}
-
-## for(i in seq(0,360, by=10)){
-## persp(distw, theta=i)
-## Sys.sleep(0.5)
-## }
-
-persp(distw, theta=-20, phi=13, col="lightgreen",ticktype="detailed", shade=0.3)
-x <- seq(0,1,lu)
-y <- seq(0,1,lu)
-
-lossdist.bu <- lossdist
-recovdist.bu <- recovdist
-
-prepayprob <- matrix(0,100,20)
-defaultprob <- matrix(0,100,20)
-for( t in 1:20){
- prepayprob[,t] <- h/(h+lambda)*(1-exp(-(lambda+h)*yearfrac[t]))
- defaultprob[,t] <- lambda/(h+lambda)*(1-exp(-(lambda+h)*yearfrac[t]))
-}
-
-#LCDX15 calibration
-library(statmod)
-n.int <- 100
-n.credit <- 100
-Z <- gauss.quad.prob(n.int, "normal")$nodes
-w <- gauss.quad.prob(n.int, "normal")$weights
-rho <- 0.35
-T <- length(yearfrac)
-Recov <- rep(0.35, n.credit)e
-dt <- diff(c(0, yearfrac))
-K <- c(0, 0.08, 0.15, 0.3, 1)
-lu <- 0.01
-errvec <- c()
-for(l in 1:10){
- result <- c()
- test <- c()
- Rstoch <- array(0,dim=c(T,n.int,n.credit))
- for(t in 1:T){
- for(i in 1:n.credit){
- Rstoch[t,,i] <- stochasticrecov(Recov[i],0,Z,w.bak,rho,defaultprob[i,t], defaultprob[i,t])
- }
- }
- lossdist <- c()
- prepaydist <- c()
- result <- c()
- for(i in 1:n.int){
- dpshocked <- apply(defaultprob,2,shockprob,rho=rho,Z=Z[i])
- ppshocked <- apply(prepayprob,2,shockprob,rho=rho,Z=-Z[i])
- L <- c()
- R <- c()
- for(t in 1:length(yearfrac)){
- dist <- lossrecovdist(dpshocked[,t],ppsocked[,t],Rstoch[t,i,],lu)
- #dist <- lossrecovdist(dpshocked[,t],ppshocked[,t],0.35,lu)
- L <- cbind(L,dist$L)
- R <- cbind(R,dist$R)
- }
- lossdist <- cbind(lossdist,L[,T])
- prepaydist <- cbind(prepaydist,R[,T])
- result <- rbind(result,bpvec(K,L,R,df,dt))
- }
-
- pomme <- KLfit(t(result), w, tranchemarks)
- #pomme <- lmconst(tranchemarks,t(result),rbind(rep(1,100),Z),c(1,0),T)
-
- err <-0
- for(i in 1:dim(p.bak)[1]){
- for(j in 1:dim(p.bak)[2]){
- err <- err+abs(crossprod(shockprob(p[i,j],rho,Z),pomme$weight)-p.bak[i,j])
- }
- }
-
- ptilde <- defaultprob
- for(i in 1:dim(defaultprob)[1]){
- for(j in 1:dim(defaultprob)[2]){
- ptilde[i,j] <- fit.prob(Z,pomme$weight,rho,defaultprob[i,j])
- }
- }
- p <- ptilde
- errvec <- c(errvec,err)
- w.bak <- pomme$weight
- cat(err,"\n")
-}
-
-pl<-c()
-for(i in 1:100){
- pd<-c(defaultprob[i,1],diff(defaultprob[i,]))
- pl<-c(pl,sum(pd*df*(1-0.35)))
-}
-cl<-c()
-for(i in 1:100){
- cl<-c(cl,sum(df*dt*(1-defaultprob[i,]-prepayprob[i,])))
-}
-
-loss <- function(t,P,R,lambda,mu){
- lambda/(lambda+mu)*(1-exp(-(lambda+mu)*t))*(1-R/P)-mu/((lambda+mu)*P)*(1-exp(-(lambda+mu)*t))
-}
-losstest <- function(t){
- loss(t,P,R,lambda,mu)
-}
-
-
-##tranche pricing
-library(statmod)
-n.int <- 500
-Z <- gauss.quad.prob(n.int,"normal")$nodes
-w <- gauss.quad.prob(n.int,"normal")$weights
-rho <- 0.35
-
-Lt <- c()
-Rt <- c()
-for(t in 1:21){
- L <- c()
- R <- c()
- for(i in 1:n.int){
- pZ <- shockprob(1-p[,t],rho,Z[i])
- SZ <- shockseverity(1-p[,t],0.45,1,Z[i])
- temp <- lossrecovdist(pZ,0,1-SZ,0.0045)
- L <- cbind(L,temp$L)
- R <- cbind(R,temp$R)
- }
- Lt <- cbind(Lt, as.matrix(L)%*%w)
- Rt <- cbind(Rt, as.matrix(R)%*%w)
-}
-
-hazard.rates <- runif(100)*1000
-yearfrac <- seq(0,7,0.25)
-bps <- 1e-4
-P <- exp(-outer(hazard.rates * bps, yearfrac))
-R <- rep(0.6,100)
-lu <- 0.01
-test <- lossrecovdist(1-P[,29], rep(0,100), R, 0.01)
-
-
-library(statmod)
-n.int <- 500
-Z <- gauss.quad.prob(n.int,"normal")$nodes
-w <- gauss.quad.prob(n.int,"normal")$weights
-rho <- 0.35
-
-
-cl <- makeCluster(6)
-x <- rnorm(1000000)
-clusterCall(cl, function(x) for (i in 1:100) sum(x), x)
-
-
diff --git a/cds_functions_generic.R b/cds_functions_generic.R
index ffa0e3c3..4f73e2d9 100644
--- a/cds_functions_generic.R
+++ b/cds_functions_generic.R
@@ -565,10 +565,18 @@ SP <- function(sc){
SPmatrix <- function(portfolio, index){
+ ## computes matrix of survival probability
+ ## inputs:
+ ## portfolio: portfolio of survival curves
+ ## index: index representation
+ ## ouput:
+ ## matrix of survival probabilities of dimensions dim1 x dim2
+ ## with dim1 number of issuers and dim2 number of dates in the
+ ## coupon schedule of index
cs <- couponSchedule(nextIMMDate(today()), index$maturity, "Q", "FIXED", index$coupon)
SP <- matrix(0, length(portfolio), length(cs$dates))
for(i in 1:length(portfolio)){
- SP[i,] <- PD(portfolio[[i]]@curve)[1:length(cs$dates)]
+ SP[i,] <- SP(portfolio[[i]]@curve)[1:length(cs$dates)]
}
return( SP )
}
@@ -586,7 +594,7 @@ DP2 <- function(sc){
}
SPmatrix2 <- function(portfolio, dealdata){
- ## computes the default probability and prepay matrix of a portfolio
+ ## computes the default and prepay probability matrix of a portfolio
## at the dates specified from dealdata
dates <- seq(dealdata$"Deal Next Pay Date", dealdata$maturity, by="3 months")
T <- yearFrac(today(), dates)
diff --git a/lossdistrib.c b/lossdistrib.c
index 2d237e22..7e5a8908 100644
--- a/lossdistrib.c
+++ b/lossdistrib.c
@@ -234,7 +234,7 @@ void addandmultiply(double *X, double alpha, double *Y, int n) {
}
}
-void BClossdist(double *SurvProb, int *dim1, int *dim2, double *recov, double *issuerweights, double *Z, double *w, int *n, double *rho, double *lu, double *L, double *R) {
+void BClossdist(double *SurvProb, int *dim1, int *dim2, double *issuerweights, double *recov, double *Z, double *w, int *n, double *rho, double *lu, double *L, double *R) {
/*
computes the loss and recovery distribution over time with a flat gaussiancorrelation
inputs:
diff --git a/plot_distributions.R b/plot_distributions.R
new file mode 100644
index 00000000..840a9ea0
--- /dev/null
+++ b/plot_distributions.R
@@ -0,0 +1,35 @@
+## some plots
+matplot(Z, cbind(w, w.mod), type="l", ylab="probability density",
+ main="Factor distribution (Gaussian, and Market implied)")
+lossdist <- array(0, dim=c(1/lu+1, n.int))
+for(i in 1:n.int){
+ pshocked <- sapply(p[,ncol(p)], shockprob, rho=rho, Z=Z[i])
+ S <- 1 - Rstoch[i,,ncol(p)]
+ lossdist[,i] <- lossrecovdist(pshocked, 0, issuerweights, S, lu)$L
+}
+
+lossdist.orig <- BClossdistC(SurvProb, issuerweights, recov, rho, lu)
+matplot(seq(0,1,0.01), cbind(lossdist.orig$L[,ncol(p)], lossdist%*%w.mod), type="l", xlab="loss percentage",
+ ylab="probability density", main="market implied loss distribution")
+#3d surface of the loss distribution
+Rstoch <- array(0, dim=c(ncol(SurvProb), n.int, n.credit))
+for(t in 1:ncol(SurvProb)){
+ for(i in 1:n.credit){
+ Rstoch[t,,i] <- stochasticrecov(recov[i], 0, Z, w.mod, rho, defaultprob[i,t], p[i,t])
+ }
+}
+lu <- 0.01
+clusterExport(cl, list("p", "shockprob", "rho", "Z", "lossdistribC.joint", "Rstoch", "lu"))
+
+parf <- function(i){
+ pshocked <- apply(p, 2, shockprob, rho=rho, Z=Z[i])
+ return( lossdistribC.joint(pshocked[,ncol(p)], issuerweights, 1-Rstoch[ncol(p),i,], lu) )
+}
+
+dist <- parSapply(cl, 1:n.int, parf)
+dist <- array(dist, dim=c(1/lu+1, 1/lu+1, 100))
+distw <- array(0, dim=c(1/lu+1, 1/lu+1))
+for(i in 1:n.int){
+ distw <- distw+dist[,,i] * w.mod[i]
+}
+persp(distw, theta=-20, phi=13, col="lightgreen",ticktype="detailed", shade=0.6, expand=0.8, border=NA, ltheta=10)
diff --git a/tranche_functions.R b/tranche_functions.R
index 42597c68..159158fb 100644
--- a/tranche_functions.R
+++ b/tranche_functions.R
@@ -193,13 +193,13 @@ lossrecovdist <- function(defaultprob, prepayprob, w, S, lu, useC=TRUE){
return(list(L=L, R=R))
}
-lossrecovdist.term <- function(defaultprob, prepayprob, S, lu, useC=TRUE){
+lossrecovdist.term <- function(defaultprob, prepayprob, w, S, lu, useC=TRUE){
## computes the loss and recovery distribution over time
L <- array(0, dim=c(1/lu+1, ncol(defaultprob)))
R <- array(0, dim=c(1/lu+1, ncol(defaultprob)))
if(prepayprob==0){
for(t in 1:ncol(defaultprob)){
- temp <- lossrecovdist(defaultprob[,t], 0, S[,t], lu, useC)
+ temp <- lossrecovdist(defaultprob[,t], 0, w, S[,t], lu, useC)
L[,t] <- temp$L
R[,t] <- temp$R
}
@@ -307,7 +307,7 @@ tranche.bpvec <- function(K, L, R, cs){
return( r )
}
-BClossdist <- function(SurvProb, recov, rho, lu, n.int=100){
+BClossdist <- function(SurvProb, issuerweights, recov, rho, lu, n.int=100){
quadrature <- gauss.quad.prob(n.int, "normal")
Z <- quadrature$nodes
w <- quadrature$weights
@@ -321,7 +321,7 @@ BClossdist <- function(SurvProb, recov, rho, lu, n.int=100){
for(i in 1:length(Z)){
g.shocked <- shockprob(g, rho, Z[i])
S.shocked <- shockseverity(1-recov, 1, Z[i], rho, g)
- temp <- lossrecovdist(g.shocked, 0, S.shocked, lu)
+ temp <- lossrecovdist(g.shocked, 0, issuerweights, S.shocked, lu)
LZ[,i] <- temp$L
RZ[,i] <- temp$R
}
@@ -331,7 +331,7 @@ BClossdist <- function(SurvProb, recov, rho, lu, n.int=100){
list(L=L, R=R)
}
-BClossdistC <- function(SurvProb, recov, rho, lu, n.int=100){
+BClossdistC <- function(SurvProb, issuerweights, recov, rho, lu, n.int=100){
dyn.load("lossdistrib.dll")
quadrature <- gauss.quad.prob(n.int, "normal")
Z <- quadrature$nodes
@@ -339,6 +339,6 @@ BClossdistC <- function(SurvProb, recov, rho, lu, n.int=100){
N <- as.integer(1/lu+1)
L <- matrix(0, N, dim(SurvProb)[2])
R <- matrix(0, N, dim(SurvProb)[2])
- r <- .C("BClossdist", SurvProb, as.integer(dim(SurvProb)[1]), as.integer(dim(SurvProb)[2]), as.double(recov), as.double(Z), as.double(w), as.integer(n.int), as.double(rho), as.double(lu), L=L, R=R)
+ r <- .C("BClossdist", SurvProb, as.integer(dim(SurvProb)[1]), as.integer(dim(SurvProb)[2]), as.double(issuerweights), as.double(recov), as.double(Z), as.double(w), as.integer(n.int), as.double(rho), as.double(lu), L=L, R=R)
return(list(L=r$L,R=r$R))
}
generated by cgit v1.2.3-70-g09d2 (git 2.52.0) at 2026-01-22 12:10:43 +0000