aboutsummaryrefslogtreecommitdiffstats
path: root/R/tranche_functions.R
diff options
context:
space:
mode:
Diffstat (limited to 'R/tranche_functions.R')
-rw-r--r--R/tranche_functions.R142
1 files changed, 63 insertions, 79 deletions
diff --git a/R/tranche_functions.R b/R/tranche_functions.R
index f08dd6c9..2b7a6219 100644
--- a/R/tranche_functions.R
+++ b/R/tranche_functions.R
@@ -451,7 +451,11 @@ dist.transform <- function(dist.joint){
shockprob <- function(p, rho, Z, log.p=F){
## computes the shocked default probability as a function of the copula factor
- pnorm((qnorm(p)-sqrt(rho)*Z)/sqrt(1-rho), log.p=log.p)
+ if(rho==1){
+ return(Z<=qnorm(p))
+ }else{
+ pnorm((qnorm(p)-sqrt(rho)*Z)/sqrt(1-rho), log.p=log.p)
+ }
}
shockseverity <- function(S, Stilde=1, Z, rho, p){
@@ -470,22 +474,26 @@ dqnorm <- function(x){
fit.prob <- function(Z, w, rho, p0){
## if the weights are not perfectly gaussian, find the probability p such
## E_w(shockprob(p, rho, Z)) = p0
+ require(distr)
if(p0==0){
return(0)
- }else{
- eps <- 1e-12
- dp <- (crossprod(shockprob(p0,rho,Z),w)-p0)/crossprod(dshockprob(p0,rho,Z),w)
- p <- p0
- while(abs(dp) > eps){
- dp <- (crossprod(shockprob(p,rho,Z),w)-p0)/crossprod(dshockprob(p,rho,Z),w)
- phi <- 1
- while ((p-phi*dp)<0 || (p-phi*dp)>1){
- phi <- 0.8*phi
- }
- p <- p - phi*dp
+ }
+ if(rho == 1){
+ distw <- DiscreteDistribution(Z, w)
+ return(pnorm(q(distw)(p0)))
+ }
+ eps <- 1e-12
+ dp <- (crossprod(shockprob(p0,rho,Z),w)-p0)/crossprod(dshockprob(p0,rho,Z),w)
+ p <- p0
+ while(abs(dp) > eps){
+ dp <- (crossprod(shockprob(p,rho,Z),w)-p0)/crossprod(dshockprob(p,rho,Z),w)
+ phi <- 1
+ while ((p-phi*dp)<0 || (p-phi*dp)>1){
+ phi <- 0.8*phi
}
- return(p)
+ p <- p - phi*dp
}
+ return(p)
}
fit.probC <- function(Z, w, rho, p0){
@@ -648,27 +656,29 @@ tranche.pvvec <- function(K, L, R, cs){
return( r )
}
-BClossdist <- function(defaultprob, issuerweights, recov, rho, N=length(recov)+1,
- n.int=100){
+BClossdist <- function(defaultprob, issuerweights, recov, rho, Z, w,
+ N=length(recov)+1, defaultflag=FALSE){
+ if(missing(Z)){
quadrature <- gauss.quad.prob(n.int, "normal")
Z <- quadrature$nodes
w <- quadrature$weights
- LZ <- matrix(0, N, n.int)
- RZ <- matrix(0, N, n.int)
- L <- matrix(0, N, ncol(defaultprob))
- R <- matrix(0, N, ncol(defaultprob))
- for(t in 1:ncol(defaultprob)){
- for(i in 1:length(Z)){
- 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
- }
- L[,t] <- LZ%*%w
- R[,t] <- RZ%*%w
+ }
+ LZ <- matrix(0, N, n.int)
+ RZ <- matrix(0, N, n.int)
+ L <- matrix(0, N, ncol(defaultprob))
+ R <- matrix(0, N, ncol(defaultprob))
+ for(t in 1:ncol(defaultprob)){
+ for(i in 1:length(Z)){
+ 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
}
- list(L=L, R=R)
+ L[,t] <- LZ%*%w
+ R[,t] <- RZ%*%w
+ }
+ list(L=L, R=R)
}
BClossdistC <- function(defaultprob, issuerweights, recov, rho, Z, w,
@@ -764,7 +774,7 @@ MFupdate.prob <- function(Z, w, rho, defaultprob){
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, w, rho, defaultprob[i,j])
+ p[i,j] <- fit.prob(Z, w, rho[i], defaultprob[i,j])
}
}
return( p )
@@ -782,39 +792,12 @@ MFupdate.probC <- function(Z, w, rho, defaultprob){
for(i in 1:nrow(defaultprob)){
for(j in 1:ncol(defaultprob)){
p[i,j] <- .C("fitprob", as.double(Z), as.double(w), as.integer(length(Z)),
- as.double(rho), as.double(defaultprob[i,j]), q = double(1))$q
+ as.double(rho[i]), as.double(defaultprob[i,j]), q = double(1))$q
}
}
return( p )
}
-
-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)
- n.int <- length(w)
- 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], defaultprobmod[i,t])
- }
- }
- 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, defaultflag)
- }
- L <- matrix(0, Ngrid, ncol(defaultprob))
- R <- matrix(0, Ngrid, ncol(defaultprob))
- for(i in 1:length(w)){
- dist <- parf(i)
- L <- L + dist$L * w[i]
- R <- R + dist$R * w[i]
- }
- return( list(L=L, R=R) )
-}
-
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
@@ -875,30 +858,31 @@ MFlossdist.joint <- function(cl, w, Z, rho, defaultprob, defaultprobmod, issuerw
}
MFlossdist.prepay.joint <- function(w, Z, rho, defaultprob, defaultprobmod,
- prepayprob, prepayprobmod, issuerweights, recov,
- 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
- ## 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)
- n.int <- length(w)
- Rstoch <- array(0, dim=c(n.credit, n.int, ncol(defaultprob)))
+ prepayprob, prepayprobmod, issuerweights, recov,
+ 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
+ ## 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)
+ n.int <- length(w)
+ Rstoch <- array(0, dim=c(n.credit, n.int, ncol(defaultprob)))
- for(t in 1:ncol(defaultprob)){
- for(i in 1:n.credit){
- Rstoch[i,,t] <- stochasticrecovC(recov[i], 0, Z, w, rho, defaultprob[i,t], defaultprobmod[i,t])
- }
+ for(t in 1:ncol(defaultprob)){
+ for(i in 1:n.credit){
+ Rstoch[i,,t] <- stochasticrecovC(recov[i], 0, Z, w, rho[i],
+ defaultprob[i,t], defaultprobmod[i,t])
}
+ }
- Q <- array(0, dim=c(ncol(defaultprob), Ngrid, Ngrid))
- for(t in 1:ncol(defaultprob)){
- S <- 1 - Rstoch[,,t]
- Q[t,,] <- lossdistC.prepay.jointZ(defaultprobmod[,t], prepayprobmod[,t], issuerweights,
- S, Ngrid, defaultflag, rho, Z, w)
+ Q <- array(0, dim=c(ncol(defaultprob), Ngrid, Ngrid))
+ for(t in 1:ncol(defaultprob)){
+ S <- 1 - Rstoch[,,t]
+ Q[t,,] <- lossdistC.prepay.jointZ(defaultprobmod[,t], prepayprobmod[,t], issuerweights,
+ S, Ngrid, defaultflag, rho, Z, w)
}
- return( Q )
+ return( Q )
}
MFtranche.pv <- function(cl, cs, w, rho, defaultprob, defaultprobmod, issuerweights, recov,
generated by cgit v1.2.3-70-g09d2 (git 2.52.0) at 2026-01-15 01:13:42 +0000