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;
}
