diff options
Diffstat (limited to 'R/tranche_functions.R')
| -rw-r--r-- | R/tranche_functions.R | 41 |
1 files changed, 28 insertions, 13 deletions
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")){
|