diff options
Diffstat (limited to 'R')
| -rw-r--r-- | R/lossdistrib.c | 6 | ||||
| -rw-r--r-- | R/script_calibrate_tranches.R | 9 | ||||
| -rw-r--r-- | R/tranche_functions.R | 41 |
3 files changed, 37 insertions, 19 deletions
diff --git a/R/lossdistrib.c b/R/lossdistrib.c index e8ba0454..6d40b711 100644 --- a/R/lossdistrib.c +++ b/R/lossdistrib.c @@ -502,7 +502,7 @@ void lossdistrib_joint_Z(double *dp, int *ndp, double *w, free(qmat);
}
-void BClossdist(double *SurvProb, int *dim1, int *dim2, double *issuerweights,
+void BClossdist(double *defaultprob, int *dim1, int *dim2, double *issuerweights,
double *recov, double *Z, double *w, int *n, double *rho, int *N,
int *defaultflag, double *L, double *R) {
/*
@@ -534,7 +534,7 @@ void BClossdist(double *SurvProb, int *dim1, int *dim2, double *issuerweights, for(t=0; t < (*dim2); t++) {
for(i=0; i < *n; i++){
for(j=0; j < (*dim1); j++){
- g = 1 - SurvProb[j + (*dim1) * t];
+ g = defaultprob[j + (*dim1) * t];
gshocked[j] = shockprob(g, *rho, Z[i], 0);
Sshocked[j] = shockseverity(1-recov[j], Z[i], *rho, g);
Rshocked[j] = 1 - Sshocked[j];
@@ -546,7 +546,7 @@ void BClossdist(double *SurvProb, int *dim1, int *dim2, double *issuerweights, lossdistrib(gshocked, dim1, issuerweights, Rshocked, N, defaultflag, Rw);
/* addandmultiply(Lw, w[i], L + t * (*N), *N); */
/* addandmultiply(Rw, w[i], R + t * (*N), *N); */
- daxpy_(N, w + i, Lw, &one, R + t * (*N), &one);
+ daxpy_(N, w + i, Lw, &one, L + t * (*N), &one);
daxpy_(N, w + i, Rw, &one, R + t * (*N), &one);
}
}
diff --git a/R/script_calibrate_tranches.R b/R/script_calibrate_tranches.R index fae154fd..4e321649 100644 --- a/R/script_calibrate_tranches.R +++ b/R/script_calibrate_tranches.R @@ -117,17 +117,20 @@ for(l in 1:100){ errvec <- c(errvec, err)
## update the new probabilities
- p <- MFupdate.prob(Z, program$weight, rho, defaultprob)
+ p <- MFupdate.probC(Z, program$weight, rho, defaultprob)
errvec <- c(errvec, err)
w.mod <- program$weight
cat(err,"\n")
}
+dist <- BClossdistC(p, issuerweights, recov, rho, Z, w.mod, Ngrid, n.int)
+
write.table(data.frame(Z=Z, w=w.mod),
file=file.path(root.dir, "Scenarios", "Calibration",
paste0("calibration-", workdate, ".csv")),
col.names=T, row.names=F, sep=",")
-save(singlenames.data, hy19, tranche.upf,
+
+save(singlenames.data, hy19, tranche.upf, dist,
file = file.path(root.dir, "Scenarios", "Calibration",
- paste0("marketdata-", workdate, ".RData")))
+ paste0("marketdata-", workdate, ".RData")), compress="xz")
diff --git a/R/tranche_functions.R b/R/tranche_functions.R index 9e6e7c74..243a222c 100644 --- a/R/tranche_functions.R +++ b/R/tranche_functions.R @@ -532,6 +532,25 @@ tranche.cl.scenarios <- function(l, r, cs, K1, K2, scaled=FALSE){ }
}
+funded.tranche.pv <- function(L, R, cs, K1, K2, scaled = FALSE){
+ if(K1==K2){
+ return(0)
+ }else{
+ size <- K2 - K1 -trancheloss(L, K1, K2) - trancherecov(R, K1, K2)
+ sizeadj <- as.numeric(0.5 * (size + c(K2-K1, size[-length(size)])))
+ interest <- 1/(K2-K1) * crossprod(sizeadj * cs$coupons, cs$df)
+ principal <- trancherecov(R, K1, K2)
+ principal[length(principal)] <- size[length(size)]
+ principal <- crossprod(cs$df, principal)
+ if(scaled){
+ pv <- (interest + principal)/(K2-K1)
+ }else{
+ pv <- (interest + principal)
+ }
+ return(pv)
+ }
+}
+
tranche.pl <- function(L, cs, K1, K2, Ngrid=nrow(L), scaled=FALSE){
## computes the protection leg of a tranche
## if scaled
@@ -589,7 +608,7 @@ tranche.pvvec <- function(K, L, R, cs){ return( r )
}
-BClossdist <- function(SurvProb, issuerweights, recov, rho, N=length(recov)+1,
+BClossdist <- function(defaultprob, issuerweights, recov, rho, N=length(recov)+1,
n.int=100){
quadrature <- gauss.quad.prob(n.int, "normal")
Z <- quadrature$nodes
@@ -599,10 +618,9 @@ BClossdist <- function(SurvProb, issuerweights, recov, rho, N=length(recov)+1, L <- matrix(0, N, ncol(SurvProb))
R <- matrix(0, N, ncol(SurvProb))
for(t in 1:ncol(SurvProb)){
- g <- 1 - SurvProb[, t]
for(i in 1:length(Z)){
- g.shocked <- shockprob(g, rho, Z[i])
- S.shocked <- shockseverity(1-recov, 1, Z[i], rho, g)
+ g.shocked <- shockprob(defaultprob[,t], rho, Z[i])
+ S.shocked <- shockseverity(1-recov, 1, Z[i], rho, defaultprob[,t])
temp <- lossrecovdist(g.shocked, 0, issuerweights, S.shocked, N)
LZ[,i] <- temp$L
RZ[,i] <- temp$R
@@ -613,17 +631,14 @@ BClossdist <- function(SurvProb, issuerweights, recov, rho, N=length(recov)+1, list(L=L, R=R)
}
-BClossdistC <- function(SurvProb, issuerweights, recov, rho,
- N=length(issuerweights)+1, n.int=100, defaultflag){
+BClossdistC <- function(defaultprob, issuerweights, recov, rho, Z, w,
+ N=length(issuerweights)+1, n.int=100, defaultflag=FALSE){
if(!is.loaded("BClossdist")){
dyn.load(file.path(root.dir, "code", "R", paste0("lossdistrib", .Platform$dynlib.ext)))
}
- quadrature <- gauss.quad.prob(n.int, "normal")
- Z <- quadrature$nodes
- w <- quadrature$weights
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]),
+ r <- .C("BClossdist", defaultprob, dim(defaultprob)[1], dim(defaultprob)[2],
as.double(issuerweights), as.double(recov), as.double(Z), as.double(w),
as.integer(n.int), as.double(rho), as.integer(N), as.logical(defaultflag), L=L, R=R)
return(list(L=r$L,R=r$R))
@@ -643,9 +658,9 @@ BCtranche.pv <- function(portfolio, index, coupon, K1, K2, rho1, rho2, N=length( issuerweights <- rep(1/length(portfolio), length(portfolio))
K <- adjust.attachments(c(K1,K2), index$loss, index$factor)
dK <- K[2] - K[1]
- dist2 <- BClossdistC(SurvProb, issuerweights, recov, rho2, N)
+ dist2 <- BClossdistC(1-SurvProb, issuerweights, recov, rho2, N)
if(rho1!=0){
- dist1 <- BClossdistC(SurvProb, issuerweights, recov, rho1, N)
+ dist1 <- BClossdistC(1-SurvProb, issuerweights, recov, rho1, N)
}
cl2 <- tranche.cl(dist2$L, dist2$R, cs, 0, K[2])
cl1 <- tranche.cl(dist1$L, dist1$R, cs, 0, K[1])
@@ -714,7 +729,7 @@ MFupdate.prob <- function(Z, w, rho, defaultprob){ }
MFupdate.probC <- function(Z, w, rho, defaultprob){
- ## update the probabilites based on a non gaussian factor
+ ## update the probabilities based on a non gaussian factor
## distribution so that the pv of the cds stays the same.
p <- matrix(0, nrow(defaultprob), ncol(defaultprob))
if(!is.loaded("fitprob")){
|