94 SEXP Pnames, Cnames,
Snames, pcnames;
102 int npar, nrep, nvar,
ncovars, nsims, ns;
104 nsims = *(INTEGER(AS_INTEGER(nsim)));
106 PROTECT(Pnames = GET_ROWNAMES(GET_DIMNAMES(
params)));
107 PROTECT(pcnames = GET_COLNAMES(GET_DIMNAMES(
params)));
109 dim = INTEGER(GET_DIM(
params));
110 npar = dim[0]; nrep = dim[1];
116 PROTECT(cvec = NEW_NUMERIC(
ncovars));
122 PROTECT(
args = GET_SLOT(
object,install(
"userdata")));
124 PROTECT(pompfun = GET_SLOT(
object,install(
"rinit")));
125 PROTECT(
Snames = GET_SLOT(pompfun,install(
"statenames")));
135 double *time = REAL(AS_NUMERIC(t0));
136 double *ps = REAL(
params);
137 double *xs, *xt = NULL;
143 PROTECT(ans = AS_NUMERIC(ans));
144 PROTECT(
Snames = GET_NAMES(ans));
147 err(
"user 'rinit' must return a named numeric vector.");
151 midx = INTEGER(PROTECT(match(Pnames,
Snames,0)));
153 for (j = 0; j < nvar; j++) {
155 err(
"a state variable and a parameter share the name: '%s'.",CHAR(STRING_ELT(
Snames,j)));
161 memcpy(xt,xs,nvar*
sizeof(
double));
165 for (j = 1, xt += nvar; j < ns; j++, xt += nvar) {
168 if (LENGTH(ans) != nvar)
169 err(
"user 'rinit' returns vectors of variable length.");
170 memcpy(xt,xs,nvar*
sizeof(
double));
180 int *sidx, *pidx, *cidx;
181 double *xt, *ps, time;
185 nvar = *INTEGER(GET_SLOT(
object,install(
"nstatevars")));
188 sidx = INTEGER(GET_SLOT(pompfun,install(
"stateindex")));
189 pidx = INTEGER(GET_SLOT(pompfun,install(
"paramindex")));
190 cidx = INTEGER(GET_SLOT(pompfun,install(
"covarindex")));
193 *((
void **) (&ff)) = R_ExternalPtrAddr(
fn);
200 for (j = 0, xt = REAL(x), ps = REAL(
params); j < ns; j++, xt += nvar)
201 (*ff)(xt,ps+npar*(j%nrep),time,sidx,pidx,cidx,
cov);
224 if (isNull(pcnames)) {
225 PROTECT(pcnames = NEW_INTEGER(nrep)); nprotect++;
226 for (k = 0, p = INTEGER(pcnames); k < nrep; k++, p++) *p = k+1;
232 PROTECT(us = mkString(
"_"));
233 PROTECT(xn = NEW_INTEGER(ns));
234 for (k = 0, sp = INTEGER(xn); k < ns; k++, sp++) *sp = (k/nrep)+1;
235 PROTECT(xn =
paste0(pcnames,us,xn));
236 PROTECT(dn = GET_DIMNAMES(x));
238 SET_ELEMENT(dn,1,xn);
243 PROTECT(dn = GET_DIMNAMES(x)); nprotect++;
244 SET_ELEMENT(dn,1,pcnames);
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)
void pomp_rinit(double *x, const double *p, double t0, const int *stateindex, const int *parindex, const int *covindex, const double *covars)
static R_INLINE int invalid_names(SEXP names)
static R_INLINE SEXP as_matrix(SEXP x)
static R_INLINE SEXP ret_array(int m, int n, SEXP names)
static R_INLINE SEXP paste0(SEXP a, SEXP b, SEXP c)
static SEXP pomp_default_rinit(SEXP params, SEXP Pnames, int npar, int nrep, int nsim)
static R_INLINE SEXP eval_call(SEXP fn, SEXP args, double *t0, double *p, int npar, double *c, int ncov)
static R_INLINE SEXP add_args(SEXP args, SEXP Pnames, SEXP Cnames)