diff options
Diffstat (limited to 'R')
| -rw-r--r-- | R/lossdistrib.c | 85 | ||||
| -rw-r--r-- | R/tranche_functions.R | 26 |
2 files changed, 110 insertions, 1 deletions
diff --git a/R/lossdistrib.c b/R/lossdistrib.c index 8f4f0ccf..e8ba0454 100644 --- a/R/lossdistrib.c +++ b/R/lossdistrib.c @@ -4,12 +4,54 @@ #include <omp.h>
#define MIN(x, y) (((x) < (y)) ? (x) : (y))
+
extern int dgemv_(char* trans, int *m, int *n, double* alpha, double* A, int* lda,
double* x, int* incx, double* beta, double* y, int* incy);
extern double ddot_(int* n, double* dx, int* incx, double* dy, int* incy);
+
extern int daxpy_(int* n, double* da, double* dx, int* incx, double* dy, int* incy);
-void lossdistrib(double *p, int *np, double *w, double *S, int *N, int* defaultflag, double *q) {
+void lossdistrib(double *p, int *np, double *w, double *S, int *N, int *defaultflag, double *q);
+
+double shockprob(double p, double rho, double Z, int give_log);
+
+void lossdistrib_Z(double *p, int *np, double *w, double *S, int *N, int *defaultflag,
+ double *rho, double *Z, double *wZ, int *nZ, double *q);
+
+void lossdistrib_truncated(double *p, int *np, double *w, double *S, int *N,
+ int *T, int *defaultflag, double *q);
+
+void lossdistrib_joint( double *p, int *np, double *w, double *S, int *N, int *defaultflag, double *q);
+
+void recovdist(double *dp, double *pp, int *n, double *w, double *S, int *N, double *q);
+
+void lossdistrib_prepay_joint(double *dp, double *pp, int *ndp, double *w,
+ double *S, int *N, int *defaultflag, double *q);
+double dqnorm(double x);
+
+double dshockprob(double p, double rho, double Z);
+
+void shockprobvec2(double p, double rho, double* Z, int nZ, double *q);
+
+double shockseverity(double S, double Z, double rho, double p);
+
+void fitprob(double* Z, double* w, int* nZ, double* rho, double* p0, double* result);
+
+void stochasticrecov(double* R, double* Rtilde, double* Z, double* w, int* nZ, double* rho,
+ double* porig, double* pmod, double* q);
+
+void lossdistrib_prepay_joint_Z(double *dp, double *pp, int *ndp, double *w,
+ double *S, int *N, int *defaultflag, double *rho,
+ double *Z, double *wZ, int *nZ, double *q);
+void lossdistrib_joint_Z(double *dp, int *ndp, double *w,
+ double *S, int *N, int *defaultflag, double *rho,
+ double *Z, double *wZ, int *nZ, double *q);
+
+void BClossdist(double *SurvProb, int *dim1, int *dim2, double *issuerweights,
+ double *recov, double *Z, double *w, int *n, double *rho, int *N,
+ int *defaultflag, double *L, double *R);
+
+void lossdistrib(double *p, int *np, double *w, double *S, int *N, int *defaultflag, double *q) {
/* recursive algorithm with first order correction for computing
the loss distribution.
p vector of default probabilities
@@ -55,6 +97,21 @@ void lossdistrib(double *p, int *np, double *w, double *S, int *N, int* defaultf Free(qtemp);
}
+void lossdistrib_Z(double *p, int *np, double *w, double *S, int *N, int *defaultflag,
+ double *rho, double *Z, double *wZ, int *nZ, double *q){
+ int i, j;
+ double* pshocked = malloc(sizeof(double) * (*np) * (*nZ));
+
+#pragma omp parallel for private(j)
+ for(i = 0; i < *nZ; i++){
+ for(j = 0; j < *np; j++){
+ pshocked[j + (*np) * i] = shockprob(p[j], *rho, Z[i], 0);
+ }
+ lossdistrib(pshocked + (*np) * i, np, w, S + (*np) * i, N,
+ defaultflag, q + (*N) * i);
+ }
+}
+
void lossdistrib_truncated(double *p, int *np, double *w, double *S, int *N,
int *T, int *defaultflag, double *q) {
/* recursive algorithm with first order correction for computing
@@ -418,6 +475,32 @@ void lossdistrib_prepay_joint_Z(double *dp, double *pp, int *ndp, double *w, free(qmat);
}
+void lossdistrib_joint_Z(double *dp, int *ndp, double *w,
+ double *S, int *N, int *defaultflag, double *rho,
+ double *Z, double *wZ, int *nZ, double *q) {
+ int i, j;
+ double* dpshocked = malloc(sizeof(double) * (*ndp) * (*nZ));
+ int N2 = (*N) * (*N);
+ double* qmat = malloc(sizeof(double) * N2 * (*nZ));
+
+ double alpha = 1;
+ double beta = 0;
+ int one = 1;
+
+#pragma omp parallel for private(j)
+ for(i = 0; i < *nZ; i++){
+ for(j = 0; j < *ndp; j++){
+ dpshocked[j + (*ndp) * i] = shockprob(dp[j], *rho, Z[i], 0);
+ }
+ lossdistrib_joint(dpshocked + (*ndp) * i, ndp, w, S + (*ndp) * i, N,
+ defaultflag, qmat + N2 * i);
+ }
+
+ dgemv_("n", &N2, nZ, &alpha, qmat, &N2, wZ, &one, &beta, q, &one);
+
+ free(dpshocked);
+ free(qmat);
+}
void BClossdist(double *SurvProb, int *dim1, int *dim2, double *issuerweights,
double *recov, double *Z, double *w, int *n, double *rho, int *N,
diff --git a/R/tranche_functions.R b/R/tranche_functions.R index 4650c19b..ef13d4ff 100644 --- a/R/tranche_functions.R +++ b/R/tranche_functions.R @@ -241,6 +241,16 @@ lossdistC <- function(p, w, S, N, defaultflag=FALSE){ 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", .Platform$dynlib.ext)))
+ }
+ .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.double(wZ), as.integer(length(Z)),
+ q = matrix(0, N, length(Z)))$q
+}
+
lossdistC.truncated <- function(p, w, S, N, T=N){
## C version of lossdistrib2, roughly 50 times faster
if(!is.loaded("lossdistrib_truncated")){
@@ -269,6 +279,22 @@ lossdistC.joint <- function(p, w, S, N, defaultflag=FALSE){ 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", .Platform$dynlib.ext)))
+ }
+ 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
+}
+
lossdistC.prepay.joint <- function(dp, pp, w, S, N, defaultflag=FALSE){
## C version of lossdist.prepay.joint
if(!is.loaded("lossdistrib_prepay_joint")){
|