119 if (deltat <= 0)
err(
"'delta.t' should be a positive number.");
122 dim = INTEGER(GET_DIM(xstart));
nvars = dim[0];
nreps = dim[1];
124 ntimes = LENGTH(times);
126 PROTECT(tstart = AS_NUMERIC(tstart));
127 PROTECT(times = AS_NUMERIC(times));
128 t0 = *(REAL(tstart));
129 if (t0 > *(REAL(times)))
err(
"'t0' must be no later than 'times[1]'.");
131 SEXP
Snames, Pnames, Cnames;
132 PROTECT(
Snames = GET_ROWNAMES(GET_DIMNAMES(xstart)));
133 PROTECT(Pnames = GET_ROWNAMES(GET_DIMNAMES(
params)));
138 PROTECT(cvec = NEW_NUMERIC(
ncovars));
142 nzeros = LENGTH(accumvars);
143 int *zidx = INTEGER(PROTECT(
matchnames(
Snames,accumvars,
"state variables")));
152 memcpy(REAL(
X),REAL(xstart),
nvars*
nreps*
sizeof(
double));
157 int *pidx = 0, *sidx = 0, *cidx = 0;
169 sidx = INTEGER(GET_SLOT(func,install(
"stateindex")));
170 pidx = INTEGER(GET_SLOT(func,install(
"paramindex")));
171 cidx = INTEGER(GET_SLOT(func,install(
"covarindex")));
173 *((
void **) (&ff)) = R_ExternalPtrAddr(
fn);
179 err(
"unrecognized 'mode' %d",
mode);
185 double *xt, *time, t;
189 step = 0, xt = REAL(
X), time = REAL(times), t = t0;
198 R_CheckUserInterrupt();
200 if (t > time[step])
err(
"'times' must be an increasing sequence.");
203 for (j = 0; j <
nreps; j++)
204 for (i = 0; i < nzeros; i++)
205 xt[zidx[i]+
nvars*j] = 0.0;
224 for (k = 0; k < nstep; k++) {
230 double *ap, *pm, *xm, *ps = REAL(
params);
232 for (j = 0, pm = ps, xm = xt; j <
nreps; j++, pm +=
npars, xm +=
nvars) {
244 PROTECT(nm = GET_NAMES(ans));
246 err(
"'rprocess' must return a named numeric vector.");
251 ap = REAL(AS_NUMERIC(ans));
252 for (i = 0; i <
nvars; i++) xm[pidx[i]] = ap[i];
260 ap = REAL(AS_NUMERIC(ans));
261 for (i = 0; i <
nvars; i++) xm[pidx[i]] = ap[i];
270 (*ff)(xm,pm,sidx,pidx,cidx,
cov,t,dt);
274 err(
"unrecognized 'mode' %d",
mode);
283 if ((method ==
euler) && (k == nstep-2)) {
lookup_table_t make_covariate_table(SEXP, int *)
SEXP pomp_fun_handler(SEXP, SEXP, pompfunmode *, SEXP, SEXP, SEXP, SEXP)
void table_lookup(lookup_table_t *, double, double *)
SEXP get_covariate_names(SEXP)
int num_map_steps(double t1, double t2, double deltat)
int num_euler_steps(double t1, double t2, double *deltat)
static R_INLINE SEXP eval_call(SEXP fn, SEXP args, double *t, double *dt, double *x, int nvar, double *p, int npar, double *c, int ncov)
static R_INLINE SEXP add_args(SEXP args, SEXP Snames, SEXP Pnames, SEXP Cnames)
static R_INLINE SEXP ret_array(int n, int nreps, int ntimes, SEXP names)
void pomp_onestep_sim(double *x, const double *p, const int *stateindex, const int *parindex, const int *covindex, const double *covars, double t, double dt)
static R_INLINE SEXP matchnames(SEXP provided, SEXP needed, const char *where)
static R_INLINE int invalid_names(SEXP names)