31 SEXP x, y, names, sims;
32 SEXP returntype, retval, val, valnames;
33 int nprobe, nsims, nobs, ntimes, nvals;
36 int p, s, i, j, k, len0 = 0, len = 0;
38 PROTECT(nsim = AS_INTEGER(nsim));
39 if ((LENGTH(nsim)!=1) || (INTEGER(nsim)[0]<=0))
40 err(
"'nsim' must be a positive integer.");
42 PROTECT(gnsi = duplicate(gnsi));
46 nprobe = LENGTH(probes);
47 nvals = LENGTH(datval);
48 PROTECT(names = GET_NAMES(datval));
49 PROTECT(returntype = NEW_INTEGER(1));
50 *(INTEGER(returntype)) = 0;
52 PROTECT(y = VECTOR_ELT(sims,1));
55 nobs = INTEGER(GET_DIM(y))[0];
56 nsims = INTEGER(GET_DIM(y))[1];
57 ntimes = INTEGER(GET_DIM(y))[2];
59 xdim[0] = nobs; xdim[1] = ntimes;
64 xdim[0] = nsims; xdim[1] = nvals;
66 PROTECT(valnames = NEW_LIST(2));
67 SET_ELEMENT(valnames,1,names);
68 SET_DIMNAMES(retval,valnames);
70 for (p = 0, k = 0; p < nprobe; p++, k += len) {
72 R_CheckUserInterrupt();
74 for (s = 0; s < nsims; s++) {
79 for (j = 0; j < ntimes; j++, yp += nobs*nsims) {
80 for (i = 0; i < nobs; i++, xp++) *xp = yp[i];
84 PROTECT(val = eval(PROTECT(lang2(VECTOR_ELT(probes,p),x)),
85 CLOENV(VECTOR_ELT(probes,p))));
86 if (!IS_NUMERIC(val)) {
87 err(
"probe %d returns a non-numeric result.",p+1);
93 else if (len != len0) {
94 err(
"variable-sized results returned by probe %d.",p+1);
97 err(
"probes return different number of values on different datasets.");
99 xp = REAL(retval); yp = REAL(val);
100 for (i = 0; i < len; i++) xp[s+nsims*(i+k)] = yp[i];
107 err(
"probes return different number of values on different datasets.");
SEXP do_simulate(SEXP, SEXP, SEXP, SEXP, SEXP)
static R_INLINE void setrownames(SEXP x, SEXP names, int rank)
static R_INLINE SEXP makearray(int rank, const int *dim)