SEXP r_do_integrate(SEXP extPtr, SEXP vars, SEXP lambda, SEXP mu, SEXP drift, SEXP diffusion, SEXP nt, SEXP dt, SEXP padding) { quasse_fft *obj = (quasse_fft*)R_ExternalPtrAddr(extPtr); SEXP ret; int nkl = INTEGER(padding)[0], nkr = INTEGER(padding)[1]; int ndat = LENGTH(lambda); double c_dt = REAL(dt)[0], c_nt = INTEGER(nt)[0]; double *c_lambda=REAL(lambda), *c_mu=REAL(mu); double c_drift=REAL(drift)[0], c_diffusion=REAL(diffusion)[0]; int i, idx, nd; if ( obj == NULL ) error("Corrupt QuaSSE integrator: ptr is NULL (are you using multicore?)"); nd = LENGTH(vars) / obj->nx; idx = lookup(nd, obj->nd, obj->n_fft); if ( idx < 0 ) error("Failed to find nd = %d\n", nd); qf_copy_x(obj, REAL(vars), nd, 1); obj->lambda = REAL(lambda); obj->mu = REAL(mu); for ( i = 0; i < ndat; i++ ) obj->z[i] = exp(c_dt * (c_lambda[i] - c_mu[i])); qf_setup_kern(obj, c_drift, c_diffusion, c_dt, nkl, nkr); do_integrate(obj, c_nt, idx); obj->lambda = NULL; obj->mu = NULL; PROTECT(ret = allocMatrix(REALSXP, obj->nx, nd)); qf_copy_x(obj, REAL(ret), nd, 0); UNPROTECT(1); return ret; }
int main() { do_integrate(0.0, 10000.0, 100); }
SEXP r_do_tips(SEXP extPtr, SEXP vars, SEXP lambda, SEXP mu, SEXP drift, SEXP diffusion, SEXP nt, SEXP dt, SEXP padding) { /* Setup directly copied from r_do_integrate, except that c_dt and c_nt are not initialised */ quasse_fft *obj = (quasse_fft*)R_ExternalPtrAddr(extPtr); SEXP ret; int nkl = INTEGER(padding)[0], nkr = INTEGER(padding)[1]; int ndat = LENGTH(lambda); double c_dt, c_nt; double *c_lambda=REAL(lambda), *c_mu=REAL(mu); double c_drift=REAL(drift)[0], c_diffusion=REAL(diffusion)[0]; int i, idx; /* New setup */ int nd, nx=obj->nx; int n_fft = obj->n_fft, n_fft_m1 = obj->n_fft - 1; if ( (LENGTH(vars) / obj->nx) != obj->nd[0] ) error("Error 1\n"); /* First; allocate space: All but the first cases will be nx * 2 matrices, but the final one might be a matrix itself */ PROTECT(ret = allocVector(VECSXP, n_fft)); for ( i = 0; i < n_fft_m1; i++ ) SET_VECTOR_ELT(ret, i, allocMatrix(REALSXP, nx, 2)); SET_VECTOR_ELT(ret, n_fft_m1, allocMatrix(REALSXP, nx, obj->nd[n_fft_m1])); /* This bit proceeds exactly as r_do_integrate() */ qf_copy_x(obj, REAL(vars), LENGTH(vars) / obj->nx, 1); obj->lambda = REAL(lambda); obj->mu = REAL(mu); /* New again */ for ( idx = 0; idx < n_fft; idx++ ) { c_dt = REAL(dt)[idx]; c_nt = INTEGER(nt)[idx]; nd = obj->nd[idx]; if ( c_nt > 0 ) { for ( i = 0; i < ndat; i++ ) obj->z[i] = exp(c_dt * (c_lambda[i] - c_mu[i])); qf_setup_kern(obj, c_drift, c_diffusion, c_dt, nkl, nkr); do_integrate(obj, c_nt, idx); } if ( idx < (n_fft-1) ) qf_copy_ED(obj, REAL(VECTOR_ELT(ret, idx)), nd-1); else qf_copy_x(obj, REAL(VECTOR_ELT(ret, idx)), nd, 0); } obj->lambda = NULL; obj->mu = NULL; UNPROTECT(1); return ret; }