aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--R/tranche_functions.R116
1 files changed, 35 insertions, 81 deletions
diff --git a/R/tranche_functions.R b/R/tranche_functions.R
index cecf24b8..c969c1fd 100644
--- a/R/tranche_functions.R
+++ b/R/tranche_functions.R
@@ -1,5 +1,3 @@
-library(statmod)
-
## todo:
## -investigate other ways to interpolate the random severities on the grid
## I'm thinking that at eah severity that we add to the distribution, round it down
@@ -13,6 +11,20 @@ library(statmod)
## the market standard
hostname <- system("hostname", intern=TRUE)
+checkSymbol <- function(name){
+ if(!is.loaded(name)){
+ if(.Platform$OS.type == "unix"){
+ root.dir <- "/home/share/CorpCDOs"
+ dyn.load(file.path(root.dir, "code", "R", paste0("lossdistrib",
+ hostname,
+ .Platform$dynlib.ext)))
+ }else{
+ root.dir <- "//WDSENTINEL/share/CorpCDOs"
+ dyn.load(file.path(root.dir, "code", "R", paste0("lossdistrib",
+ .Platform$dynlib.ext)))
+ }
+ }
+}
lossdistrib <- function(p){
## basic recursive algorithm of Andersen, Sidenius and Basu
n <- length(p)
@@ -235,29 +247,20 @@ lossdist.prepay.joint <- function(dp, pp, w, S, N, defaultflag=FALSE){
lossdistC <- function(p, w, S, N, defaultflag=FALSE){
## C version of lossdistrib2, roughly 50 times faster
- if(!is.loaded("lossdistrib")){
- dyn.load(file.path(root.dir, "code", "R", paste0("lossdistrib",
- hostname, .Platform$dynlib.ext)))
- }
+ checkSymbol("lossdistrib")
.C("lossdistrib", as.double(p), as.integer(length(p)),
as.double(w), as.double(S), as.integer(N), as.logical(defaultflag), q = double(N))$q
}
lossdistCblas <- function(p, w, S, N, defaultflag=FALSE){
## C version of lossdistrib2, roughly 50 times faster
- if(!is.loaded("lossdistrib_blas")){
- dyn.load(file.path(root.dir, "code", "R", paste0("lossdistrib",
- hostname, .Platform$dynlib.ext)))
- }
+ checkSymbol("lossdistrib_blas")
.C("lossdistrib_blas", as.double(p), as.integer(length(p)),
as.double(w), as.double(S), as.integer(N), as.logical(defaultflag), q = double(N))$q
}
lossdistCZ <- function(p, w, S, N, defaultflag=FALSE, rho, Z, wZ){
- if(!is.loaded("lossdistrib_Z")){
- dyn.load(file.path(root.dir, "code", "R", paste0("lossdistrib",
- hostname, .Platform$dynlib.ext)))
- }
+ checkSymbol("lossdistrib_Z")
.C("lossdistrib_Z", as.double(p), as.integer(length(p)),
as.double(w), as.double(S), as.integer(N), as.logical(defaultflag),
as.double(rho), as.double(Z), as.integer(length(Z)),
@@ -266,62 +269,42 @@ lossdistCZ <- function(p, w, S, N, defaultflag=FALSE, rho, Z, wZ){
lossdistC.truncated <- function(p, w, S, N, T=N){
## C version of lossdistrib2, roughly 50 times faster
- if(!is.loaded("lossdistrib_truncated")){
- dyn.load(file.path(root.dir, "code", "R", paste0("lossdistrib",
- hostname,
- .Platform$dynlib.ext)))
- }
+ checkSymbol("lossdistrib_truncated")
.C("lossdistrib_truncated", as.double(p), as.integer(length(p)),
as.double(w), as.double(S), as.integer(N), as.integer(T), q = double(T))$q
}
recovdistC <- function(dp, pp, w, S, N){
## C version of recovdist
- if(!is.loaded("recovdist")){
- dyn.load(file.path(root.dir, "code", "R", paste0("lossdistrib",
- hostname,
- .Platform$dynlib.ext)))
- }
+ checkSymbol("recovdist")
.C("recovdist", as.double(dp), as.double(pp), as.integer(length(dp)),
as.double(w), as.double(S), as.integer(N), q = double(N))$q
}
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(file.path(root.dir, "code", "R", paste0("lossdistrib",
- hostname,
- .Platform$dynlib.ext)))
- }
+ checkSymbol("lossdistrib_joint")
.C("lossdistrib_joint", as.double(p), as.integer(length(p)), as.double(w),
as.double(S), as.integer(N), as.logical(defaultflag), q = matrix(0, N, N))$q
}
lossdistC.jointblas <- function(p, w, S, N, defaultflag=FALSE){
## C version of lossdistrib.joint, roughly 20 times faster
- if(!is.loaded("lossdistrib_joint_blas")){
- dyn.load(file.path(root.dir, "code", "R", paste0("lossdistrib",
- hostname,
- .Platform$dynlib.ext)))
- }
+ checkSymbol("lossdistrib_joint_blas")
.C("lossdistrib_joint_blas", as.double(p), as.integer(length(p)), as.double(w),
as.double(S), as.integer(N), as.logical(defaultflag), q = matrix(0, N, N))$q
}
lossdistC.jointZ <- function(dp, w, S, N, defaultflag = FALSE, rho, Z, wZ){
- ## N is the size of the grid
- ## dp is of size n.credits
- ## w is of size n.credits
- ## S is of size n.credits by nZ
- ## rho is a double
- ## Z is a vector of length nZ
- ## w is a vector if length wZ
- if(!is.loaded("lossdistrib_joint_Z")){
- dyn.load(file.path(root.dir, "code", "R", paste0("lossdistrib",
- hostname,
- .Platform$dynlib.ext)))
- }
+ ## N is the size of the grid
+ ## dp is of size n.credits
+ ## w is of size n.credits
+ ## S is of size n.credits by nZ
+ ## rho is a double
+ ## Z is a vector of length nZ
+ ## w is a vector if length wZ
+ checkSymbol("lossdistrib_joint_Z")
r <- .C("lossdistrib_joint_Z", as.double(dp), as.integer(length(dp)),
as.double(w), as.double(S), as.integer(N), as.logical(defaultflag), as.double(rho),
as.double(Z), as.double(wZ), as.integer(length(Z)), q = matrix(0, N, N))$q
@@ -329,11 +312,7 @@ lossdistC.jointZ <- function(dp, w, S, N, defaultflag = FALSE, rho, Z, wZ){
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(file.path(root.dir, "code", "R", paste0("lossdistrib",
- hostname,
- .Platform$dynlib.ext)))
- }
+ checkSymbol("lossdistrib_prepay_joint")
r <- .C("lossdistrib_prepay_joint", as.double(dp), as.double(pp), as.integer(length(dp)),
as.double(w), as.double(S), as.integer(N), as.logical(defaultflag), q=matrix(0, N, N))$q
return(r)
@@ -348,11 +327,7 @@ lossdistC.prepay.jointZ <- function(dp, pp, w, S, N, defaultflag = FALSE, rho, Z
## rho is a double
## Z is a vector of length nZ
## w is a vector if length wZ
- if(!is.loaded("lossdistrib_prepay_joint_Z")){
- dyn.load(file.path(root.dir, "code", "R", paste0("lossdistrib",
- hostname,
- .Platform$dynlib.ext)))
- }
+ checkSymbol("lossdistrib_prepay_joint_Z")
r <- .C("lossdistrib_prepay_joint_Z", as.double(dp), as.double(pp), as.integer(length(dp)),
as.double(w), as.double(S), as.integer(N), as.logical(defaultflag), as.double(rho),
as.double(Z), as.double(wZ), as.integer(length(Z)), q = matrix(0, N, N))$q
@@ -511,11 +486,7 @@ fit.prob <- function(Z, w, rho, p0){
}
fit.probC <- function(Z, w, rho, p0){
- if(!is.loaded("fitprob")){
- dyn.load(file.path(root.dir, "code", "R", paste0("lossdistrib",
- hostname,
- .Platform$dynlib.ext)))
- }
+ checkSymbol("fitprob")
r <- .C("fitprob", as.double(Z), as.double(w), as.integer(length(Z)),
as.double(rho), as.double(p0), q = double(1))
return(r$q)
@@ -533,11 +504,7 @@ stochasticrecov <- function(R, Rtilde, Z, w, rho, porig, pmod){
}
stochasticrecovC <- function(R, Rtilde, Z, w, rho, porig, pmod){
- if(!is.loaded("stochasticrecov")){
- dyn.load(file.path(root.dir, "code", "R", paste0("lossdistrib",
- hostname,
- .Platform$dynlib.ext)))
- }
+ checkSymbol("stochasticrecov")
r <- .C("stochasticrecov", as.double(R), as.double(Rtilde), as.double(Z),
as.double(w), as.integer(length(Z)), as.double(rho), as.double(porig),
as.double(pmod), q = double(length(Z)))
@@ -672,11 +639,6 @@ tranche.pvvec <- function(K, L, R, cs){
BClossdist <- function(defaultprob, issuerweights, recov, rho, Z, w,
N=length(recov)+1, defaultflag=FALSE, n.int=500){
- if(missing(Z)){
- quadrature <- gauss.quad.prob(n.int, "normal")
- Z <- quadrature$nodes
- w <- quadrature$weights
- }
## do not use if weights are not gaussian, results would be incorrect
## since shockseverity is invalid in that case (need to use stochasticrecov)
LZ <- matrix(0, N, length(Z))
@@ -699,11 +661,7 @@ BClossdist <- function(defaultprob, issuerweights, recov, rho, Z, w,
BClossdistC <- function(defaultprob, issuerweights, recov, rho, Z, w,
N=length(issuerweights)+1, defaultflag=FALSE){
- if(!is.loaded("BClossdist")){
- dyn.load(file.path(root.dir, "code", "R", paste0("lossdistrib",
- hostname,
- .Platform$dynlib.ext)))
- }
+ checkSymbol("BClossdist")
L <- matrix(0, N, dim(defaultprob)[2])
R <- matrix(0, N, dim(defaultprob)[2])
rho <- rep(rho, length(issuerweights))
@@ -808,11 +766,7 @@ MFupdate.probC <- function(Z, w, rho, defaultprob){
## 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")){
- dyn.load(file.path(root.dir, "code", "R", paste0("lossdistrib",
- hostname,
- .Platform$dynlib.ext)))
- }
+ checkSymbol("fitprob")
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)),
generated by cgit v1.2.3-70-g09d2 (git 2.52.0) at 2026-01-02 06:26:43 +0000