aboutsummaryrefslogtreecommitdiffstats
path: root/tranche_functions.R
diff options
context:
space:
mode:
Diffstat (limited to 'tranche_functions.R')
-rw-r--r--tranche_functions.R96
1 files changed, 58 insertions, 38 deletions
diff --git a/tranche_functions.R b/tranche_functions.R
index 479749a8..b5089b0d 100644
--- a/tranche_functions.R
+++ b/tranche_functions.R
@@ -132,7 +132,7 @@ recovdist <- function(dp, pp, w, S, N){
return(q)
}
-lossdistrib.joint <- function(p, w, S, N, defaultflag=FALSE){
+lossdist.joint <- function(p, w, S, N, defaultflag=FALSE){
## recursive algorithm with first order correction
## to compute the joint probability distribution of the loss and recovery
## inputs:
@@ -171,7 +171,7 @@ lossdistrib.joint <- function(p, w, S, N, defaultflag=FALSE){
return(q)
}
-lossdistribprepay.joint <- function(dp, pp, w, S, N, defaultflag=FALSE){
+lossdist.prepay.joint <- function(dp, pp, w, S, N, defaultflag=FALSE){
## recursive algorithm with first order correction
## to compute the joint probability distribition of the loss and recovery
## inputs:
@@ -190,29 +190,49 @@ lossdistribprepay.joint <- function(dp, pp, w, S, N, defaultflag=FALSE){
q <- matrix(0, N, N)
q[1,1] <- 1
for(k in 1:n){
- x <- S[k] * w[k]/lu
y1 <- (1-S[k]) * w[k]/lu
y2 <- w[k]/lu
- i <- floor(x)
j1 <- floor(y1)
j2 <- floor(y2)
- weights <- c((i+1-x)*(j1+1-y1), (i+1-x)*(y1-j1), (x-i)*(y1-j1), (j1+1-y1)*(x-i))
- dpsplit <- dp[k] * weights
- ppsplit <- pp[k] * c(j2+1-y2, y2-j2)
+ if(defaultflag){
+ x <- y2
+ i <- j2
+ }else{
+ x <- y2-y1
+ i <- floor(x)
+ }
+
+ ## weights <- c((i+1-x)*(j1+1-y1), (i+1-x)*(y1-j1), (x-i)*(y1-j1), (j1+1-y1)*(x-i))
+ weights1 <- c((i+1-x)*(j1+1-y1), (i+1-x)*(y1-j1), (x-i)*(y1-j1), (j1+1-y1)*(x-i))
+ dpsplit <- dp[k] * weights1
+
+ if(defaultflag){
+ weights2 <- c((i+1-x)*(j2+1-y2), (i+1-x)*(y2-j2), (x-i)*(y2-j2), (j2+1-y2)*(x-i))
+ ppsplit <- pp[k] * weights2
+ }else{
+ ppsplit <- ppk[k] * c(j2+1-y2, y2-j2)
+ }
qtemp <- matrix(0, N, N)
qtemp[(i+1):N,(j1+1):N] <- qtemp[(i+1):N,(j1+1):N] + dpsplit[1] * q[1:(N-i),1:(N-j1)]
qtemp[(i+1):N,(j1+2):N] <- qtemp[(i+1):N,(j1+2):N] + dpsplit[2] * q[1:(N-i), 1:(N-j1-1)]
qtemp[(i+2):N,(j1+2):N] <- qtemp[(i+2):N,(j1+2):N] + dpsplit[3] * q[1:(N-i-1), 1:(N-j1-1)]
qtemp[(i+2):N,(j1+1):N] <- qtemp[(i+2):N, (j1+1):N] + dpsplit[4] * q[1:(N-i-1), 1:(N-j1)]
- qtemp[, (j2+1):N] <- qtemp[,(j2+1):N]+ppsplit[1]*q[,1:(N-j2)]
- qtemp[, (j2+2):N] <- qtemp[,(j2+2):N]+ppsplit[2]*q[,1:(N-j2-1)]
+ if(defaultflag){
+ qtemp[(i+1):N,(j2+1):N] <- qtemp[(i+1):N,(j2+1):N] + ppsplit[1] * q[1:(N-i),1:(N-j2)]
+ qtemp[(i+1):N,(j2+2):N] <- qtemp[(i+1):N,(j2+2):N] + ppsplit[2] * q[1:(N-i), 1:(N-j2-1)]
+ qtemp[(i+2):N,(j2+2):N] <- qtemp[(i+2):N,(j2+2):N] + ppsplit[3] * q[1:(N-i-1), 1:(N-j2-1)]
+ qtemp[(i+2):N,(j2+1):N] <- qtemp[(i+2):N, (j2+1):N] + ppsplit[4] * q[1:(N-i-1), 1:(N-j2)]
+ }else{
+ qtemp[, (j2+1):N] <- qtemp[,(j2+1):N]+ppsplit[1]*q[,1:(N-j2)]
+ qtemp[, (j2+2):N] <- qtemp[,(j2+2):N]+ppsplit[2]*q[,1:(N-j2-1)]
+ }
q <- qtemp + (1-pp[k]-dp[k]) * q
}
q[length(q)] <- q[length(q)] + 1 - sum(q)
return(q)
}
-lossdistribC <- function(p, w, S, N, defaultflag){
+lossdistC <- function(p, w, S, N, defaultflag=FALSE){
## C version of lossdistrib2, roughly 50 times faster
if(!is.loaded("lossdistrib")){
dyn.load(paste0("lossdistrib", .Platform$dynlib.ext))
@@ -221,7 +241,7 @@ lossdistribC <- function(p, w, S, N, defaultflag){
as.double(w), as.double(S), as.integer(N), as.logical(defaultflag), q = double(N))$q
}
-lossdistribC.truncated <- function(p, w, S, N, T=N){
+lossdistC.truncated <- function(p, w, S, N, T=N){
## C version of lossdistrib2, roughly 50 times faster
if(!is.loaded("lossdistrib_truncated")){
dyn.load(paste0("lossdistrib", .Platform$dynlib.ext))
@@ -240,7 +260,7 @@ recovdistC <- function(dp, pp, w, S, N){
as.double(w), as.double(S), as.integer(N), q = double(N))$q
}
-lossdistribC.joint <- function(p, w, S, N, defaultflag=FALSE){
+lossdistC.joint <- function(p, w, S, N, defaultflag=FALSE){
## C version of lossdistrib.joint, roughly 20 times faster
if(!is.loaded("lossdistrib_joint")){
dyn.load(paste0("lossdistrib", .Platform$dynlib.ext))
@@ -249,8 +269,8 @@ lossdistribC.joint <- function(p, w, S, N, defaultflag=FALSE){
as.double(S), as.integer(N), as.logical(defaultflag), q = matrix(0, N, N))$q
}
-lossdistribprepayC.joint <- function(dp, pp, w, S, N, defaultflag=FALSE){
- ## C version of lossdistribprepay.joint
+lossdistC.prepay.joint <- function(dp, pp, w, S, N, defaultflag=FALSE){
+ ## C version of lossdist.prepay.joint
if(!is.loaded("lossdistrib_prepay_joint")){
dyn.load(paste0("lossdistrib", .Platform$dynlib.ext))
}
@@ -258,21 +278,21 @@ lossdistribprepayC.joint <- function(dp, pp, w, S, N, defaultflag=FALSE){
as.double(w), as.double(S), as.integer(N), as.logical(defaultflag), q=matrix(0, N, N))$q
}
-lossrecovdist <- function(defaultprob, prepayprob, w, S, N, defaultflag, useC=TRUE){
+lossrecovdist <- function(defaultprob, prepayprob, w, S, N, defaultflag=FALSE, useC=TRUE){
if(all(!prepayprob)){
if(useC){
- L <- lossdistribC(defaultprob, w, S, N, defaultflag)
- R <- lossdistribC(defaultprob, w, 1-S, N)
+ L <- lossdistC(defaultprob, w, S, N, defaultflag)
+ R <- lossdistC(defaultprob, w, 1-S, N)
}else{
L <- lossdistrib2(defaultprob, w, S, N, defaultflag)
R <- lossdistrib2(defaultprob, w, 1-S, N)
}
}else{
if(useC){
- L <- lossdistribC(defaultprob, w, S, N, defaultflag)
+ L <- lossdistC(defaultprob+defaultflag*prepayprob, w, S, N, defaultflag)
R <- recovdistC(defaultprob, prepayprob, w, S, N)
}else{
- L <- lossdistrib2(defaultprob, w, S, N, defaultflag)
+ L <- lossdistrib2(defaultprob+defaultflag*prepayprob, w, S, N, defaultflag)
R <- recovdist(defaultprob, prepayprob, w, S, N)
}
}
@@ -297,21 +317,21 @@ lossrecovdist.joint.term <- function(defaultprob, prepayprob, w, S, N, defaultfl
if(useC){
if(all(!prepayprob)){
for(t in 1:ncol(defaultprob)){
- Q[t,,] <- lossdistribC.joint(defaultprob[,t], w, S[,t], N, defaultflag)
+ Q[t,,] <- lossdistC.joint(defaultprob[,t], w, S[,t], N, defaultflag)
}
}else{
for(t in 1:ncol(defaultprob)){
- Q[t,,] <- lossdistribprepayC.joint(defaultprob[,t], prepayprob[,t], w, S[,t], N, defaultflag)
+ Q[t,,] <- lossdistC.prepay.joint(defaultprob[,t], prepayprob[,t], w, S[,t], N, defaultflag)
}
}
}else{
if(all(!prepayprob)){
for(t in 1:ncol(defaultprob)){
- Q[t,,] <- lossdistrib.joint(defaultprob[,t], w, S[,t], N, defaultflag)
+ Q[t,,] <- lossdist.joint(defaultprob[,t], w, S[,t], N, defaultflag)
}
}else{
for(t in 1:ncol(defaultprob)){
- Q[t,,] <- lossdistribprepay.joint(defaultprob[,t], prepayprob[,t], w, S[,t], N, defaultflag)
+ Q[t,,] <- lossdist.prepay.joint(defaultprob[,t], prepayprob[,t], w, S[,t], N, defaultflag)
}
}
}
@@ -590,8 +610,8 @@ MFupdate.prob <- function(Z, w, rho, defaultprob){
return( p )
}
-MFlossdistrib <- function(w, Z, rho, defaultprob, defaultprobmod, issuerweights, recov,
- Ngrid=2*length(issuerweights)+1){
+MFlossrecovdist <- function(w, Z, rho, defaultprob, defaultprobmod, issuerweights, recov,
+ Ngrid=2*length(issuerweights)+1, defaultflag=FALSE){
## computes the loss and recovery distribution using the modified factor distribution
n.credit <- length(issuerweights)
Rstoch <- array(0, dim=c(n.int, n.credit, ncol(defaultprob)))
@@ -603,7 +623,7 @@ MFlossdistrib <- function(w, Z, rho, defaultprob, defaultprobmod, issuerweights,
parf <- function(i){
pshocked <- apply(defaultprobmod, 2, shockprob, rho=rho, Z=Z[i])
S <- 1 - Rstoch[i,,]
- dist <- lossrecovdist.term(pshocked, 0, issuerweights, S, Ngrid)
+ dist <- lossrecovdist.term(pshocked, 0, issuerweights, S, Ngrid, defaultflag)
}
L <- matrix(0, Ngrid, ncol(defaultprob))
R <- matrix(0, Ngrid, ncol(defaultprob))
@@ -615,8 +635,8 @@ MFlossdistrib <- function(w, Z, rho, defaultprob, defaultprobmod, issuerweights,
return( list(L=L, R=R) )
}
-MFlossrecovdist <- function(w, Z, rho, defaultprob, defaultprobmod, prepayprob, prepayprobmod,
- issuerweights, recov, Ngrid=2*length(issuerweights)+1){
+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)
Rstoch <- array(0, dim=c(n.int, n.credit, ncol(defaultprob)))
@@ -629,7 +649,7 @@ MFlossrecovdist <- function(w, Z, rho, defaultprob, defaultprobmod, prepayprob,
dpshocked <- apply(defaultprobmod, 2, shockprob, rho=rho, Z=Z[i])
ppshocked <- apply(prepayprobmod, 2, shockprob, rho=rho, Z=-Z[i])
S <- 1 - Rstoch[i,,]
- dist <- lossrecovdist.term(dpshocked, ppshocked, issuerweights, S, Ngrid)
+ dist <- lossrecovdist.term(dpshocked, ppshocked, issuerweights, S, Ngrid, defaultflag)
}
L <- matrix(0, Ngrid, ncol(defaultprob))
R <- matrix(0, Ngrid, ncol(defaultprob))
@@ -641,11 +661,11 @@ MFlossrecovdist <- function(w, Z, rho, defaultprob, defaultprobmod, prepayprob,
return( list(L=L, R=R) )
}
-MFlossdistrib2 <- function(cl, w, Z, rho, defaultprob, defaultprobmod, issuerweights, recov,
- Ngrid=2*length(issuerweights)+1){
- ## rowSums is the loss distribution
- ## colSums is the recovery distribution
- ## so that recovery is the y axis and L is the x axis
+MFlossdist.joint <- function(cl, w, Z, rho, defaultprob, defaultprobmod, issuerweights, recov,
+ Ngrid=2*length(issuerweights)+1, defaultflag=FALSE){
+ ## rowSums(Q) is the loss/default distribution
+ ## colSums(Q) is the recovery distribution
+ ## so that recovery is the y axis and L/D is the x axis
## if we use the persp function, losses is the axes facing us,
## and R is the axis going away from us.
n.credit <- length(issuerweights)
@@ -658,7 +678,7 @@ MFlossdistrib2 <- function(cl, w, Z, rho, defaultprob, defaultprobmod, issuerwei
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)
+ dist <- lossrecovdist.joint.term(pshocked, 0, issuerweights, S, Ngrid, defaultflag)
gc()
return(dist)
}
@@ -671,9 +691,9 @@ MFlossdistrib2 <- function(cl, w, Z, rho, defaultprob, defaultprobmod, issuerwei
return( Q )
}
-MFlossrecovdist2 <- function(cl, w, Z, rho, defaultprob, defaultprobmod,
+MFlossdist.prepay.joint <- function(cl, w, Z, rho, defaultprob, defaultprobmod,
prepayprob, prepayprobmod, issuerweights, recov,
- Ngrid=2*length(issuerweights)+1){
+ 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
@@ -690,7 +710,7 @@ MFlossrecovdist2 <- function(cl, w, Z, rho, defaultprob, defaultprobmod,
dpshocked <- apply(defaultprobmod, 2, shockprob, rho=rho, Z=Z[i])
ppshocked <- apply(prepayprobmod, 2, shockprob, rho=rho, Z=-Z[i])
S <- 1 - Rstoch[i,,]
- dist <- lossrecovdist.joint.term(dpshocked, ppshocked, issuerweights, S, Ngrid)
+ dist <- lossrecovdist.joint.term(dpshocked, ppshocked, issuerweights, S, Ngrid, defaultflag)
gc()
return(dist)
}
generated by cgit v1.2.3-70-g09d2 (git 2.52.0) at 2026-01-21 13:29:54 +0000