[Pomp-commits] r968 - pkg/pomp/src

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Jun 9 18:30:39 CEST 2014


Author: kingaa
Date: 2014-06-09 18:30:39 +0200 (Mon, 09 Jun 2014)
New Revision: 968

Modified:
   pkg/pomp/src/SSA_wrapper.c
   pkg/pomp/src/euler.c
   pkg/pomp/src/mif.c
   pkg/pomp/src/pfilter.c
   pkg/pomp/src/pomp_internal.h
   pkg/pomp/src/rmeasure.c
   pkg/pomp/src/rprior.c
   pkg/pomp/src/skeleton.c
   pkg/pomp/src/trajectory.c
Log:
- more informative error messages when variable names are not found using 'matchnames'

Modified: pkg/pomp/src/SSA_wrapper.c
===================================================================
--- pkg/pomp/src/SSA_wrapper.c	2014-06-09 16:30:30 UTC (rev 967)
+++ pkg/pomp/src/SSA_wrapper.c	2014-06-09 16:30:39 UTC (rev 968)
@@ -157,26 +157,26 @@
   PROTECT(X = makearray(3,xdim)); nprotect++;
   setrownames(X,Snames,3);
 
- if (nstates>0) {
-    PROTECT(sindex = MATCHROWNAMES(xstart,statenames)); nprotect++;
+  if (nstates>0) {
+    PROTECT(sindex = MATCHROWNAMES(xstart,statenames,"state variables")); nprotect++;
     sidx = INTEGER(sindex);
   } else {
     sidx = 0;
   }
   if (nparams>0) {
-    PROTECT(pindex = MATCHROWNAMES(params,paramnames)); nprotect++;
+    PROTECT(pindex = MATCHROWNAMES(params,paramnames,"parameters")); nprotect++;
     pidx = INTEGER(pindex);
   } else {
     pidx = 0;
   }
   if (ncovars>0) {
-    PROTECT(cindex = MATCHCOLNAMES(covar,covarnames)); nprotect++;
+    PROTECT(cindex = MATCHCOLNAMES(covar,covarnames,"covariates")); nprotect++;
     cidx = INTEGER(cindex);
   } else {
     cidx = 0;
   }
   if (nzeros>0) {
-    PROTECT(zindex = MATCHROWNAMES(xstart,zeronames)); nprotect++;
+    PROTECT(zindex = MATCHROWNAMES(xstart,zeronames,"state variables")); nprotect++;
     zidx = INTEGER(zindex);
   } else {
     zidx = 0;

Modified: pkg/pomp/src/euler.c
===================================================================
--- pkg/pomp/src/euler.c	2014-06-09 16:30:30 UTC (rev 967)
+++ pkg/pomp/src/euler.c	2014-06-09 16:30:39 UTC (rev 968)
@@ -40,7 +40,7 @@
 
   // indices of accumulator variables
   nzeros = LENGTH(zeronames);
-  zidx = INTEGER(PROTECT(matchnames(Snames,zeronames))); nprotect++;
+  zidx = INTEGER(PROTECT(matchnames(Snames,zeronames,"state variables"))); nprotect++;
 
   // extract user function
   PROTECT(fn = pomp_fun_handler(func,gnsi,&mode)); nprotect++;
@@ -78,9 +78,9 @@
   case 1:			// native code
 
     // construct state, parameter, covariate indices
-    sidx = INTEGER(PROTECT(matchnames(Snames,GET_SLOT(func,install("statenames"))))); nprotect++;
-    pidx = INTEGER(PROTECT(matchnames(Pnames,GET_SLOT(func,install("paramnames"))))); nprotect++;
-    cidx = INTEGER(PROTECT(matchnames(Cnames,GET_SLOT(func,install("covarnames"))))); nprotect++;
+    sidx = INTEGER(PROTECT(matchnames(Snames,GET_SLOT(func,install("statenames")),"state variables"))); nprotect++;
+    pidx = INTEGER(PROTECT(matchnames(Pnames,GET_SLOT(func,install("paramnames")),"parameters"))); nprotect++;
+    cidx = INTEGER(PROTECT(matchnames(Cnames,GET_SLOT(func,install("covarnames")),"covariates"))); nprotect++;
 
     ff = (pomp_onestep_sim *) R_ExternalPtrAddr(fn);
 
@@ -181,14 +181,14 @@
 
 	      	PROTECT(ans = eval(fcall,rho));	nprotect++; // evaluate the call
 	      	if (LENGTH(ans) != nvars) {
-	      	  error("user 'step.fun' returns a vector of %d states but %d are expected: compare initial conditions?",
+	      	  error("user 'step.fun' returns a vector of %d state variables but %d are expected: compare initial conditions?",
 	      		LENGTH(ans),nvars);
 	      	}
 		
 	      	PROTECT(nm = GET_NAMES(ans)); nprotect++;
 	      	use_names = !isNull(nm);
 	      	if (use_names) {
-	      	  posn = INTEGER(PROTECT(matchnames(Snames,nm))); nprotect++;
+	      	  posn = INTEGER(PROTECT(matchnames(Snames,nm,"state variables"))); nprotect++;
 	      	}
 
 	      	ap = REAL(AS_NUMERIC(ans));
@@ -316,9 +316,9 @@
   case 1:			// native code
 
     // construct state, parameter, covariate indices
-    sidx = INTEGER(PROTECT(matchnames(Snames,GET_SLOT(func,install("statenames"))))); nprotect++;
-    pidx = INTEGER(PROTECT(matchnames(Pnames,GET_SLOT(func,install("paramnames"))))); nprotect++;
-    cidx = INTEGER(PROTECT(matchnames(Cnames,GET_SLOT(func,install("covarnames"))))); nprotect++;
+    sidx = INTEGER(PROTECT(matchnames(Snames,GET_SLOT(func,install("statenames")),"state variables"))); nprotect++;
+    pidx = INTEGER(PROTECT(matchnames(Pnames,GET_SLOT(func,install("paramnames")),"parameters"))); nprotect++;
+    cidx = INTEGER(PROTECT(matchnames(Cnames,GET_SLOT(func,install("covarnames")),"covariates"))); nprotect++;
 
     ff = (pomp_onestep_pdf *) R_ExternalPtrAddr(fn);
 

Modified: pkg/pomp/src/mif.c
===================================================================
--- pkg/pomp/src/mif.c	2014-06-09 16:30:30 UTC (rev 967)
+++ pkg/pomp/src/mif.c	2014-06-09 16:30:39 UTC (rev 968)
@@ -26,10 +26,10 @@
   dim = INTEGER(GET_DIM(FM)); nfm = dim[0]; ntimes = dim[1];
   dim = INTEGER(GET_DIM(PV)); npv = dim[0];
 
-  sidx = INTEGER(PROTECT(MATCHNAMES(sigma,pars))); nprotect++;
-  thidx = INTEGER(PROTECT(MATCHNAMES(theta,pars))); nprotect++;
-  midx = INTEGER(PROTECT(MATCHROWNAMES(FM,pars))); nprotect++;
-  vidx = INTEGER(PROTECT(MATCHROWNAMES(PV,pars))); nprotect++;
+  sidx = INTEGER(PROTECT(MATCHNAMES(sigma,pars,"random-walk SDs"))); nprotect++;
+  thidx = INTEGER(PROTECT(MATCHNAMES(theta,pars,"parameters"))); nprotect++;
+  midx = INTEGER(PROTECT(MATCHROWNAMES(FM,pars,"filter-mean variables"))); nprotect++;
+  vidx = INTEGER(PROTECT(MATCHROWNAMES(PV,pars,"prediction-variance variables"))); nprotect++;
 
   PROTECT(newtheta = duplicate(theta)); nprotect++;
 

Modified: pkg/pomp/src/pfilter.c
===================================================================
--- pkg/pomp/src/pfilter.c	2014-06-09 16:30:30 UTC (rev 967)
+++ pkg/pomp/src/pfilter.c	2014-06-09 16:30:39 UTC (rev 968)
@@ -120,7 +120,7 @@
 
   if (do_rw) {
     // indices of parameters undergoing random walk
-    PROTECT(pindex = matchnames(Pnames,rw_names)); nprotect++; 
+    PROTECT(pindex = matchnames(Pnames,rw_names,"parameters")); nprotect++; 
     xp = REAL(params);
     pidx = INTEGER(pindex);
     nrw = LENGTH(rw_names);

Modified: pkg/pomp/src/pomp_internal.h
===================================================================
--- pkg/pomp/src/pomp_internal.h	2014-06-09 16:30:30 UTC (rev 967)
+++ pkg/pomp/src/pomp_internal.h	2014-06-09 16:30:39 UTC (rev 968)
@@ -10,9 +10,9 @@
 
 #include "pomp.h"
 
-# define MATCHNAMES(X,N) (matchnames(GET_NAMES(X),(N)))
-# define MATCHROWNAMES(X,N) (matchnames(GET_ROWNAMES(GET_DIMNAMES(X)),(N)))
-# define MATCHCOLNAMES(X,N) (matchnames(GET_COLNAMES(GET_DIMNAMES(X)),(N)))
+# define MATCHNAMES(X,N,W) (matchnames(GET_NAMES(X),(N),(W)))
+# define MATCHROWNAMES(X,N,W) (matchnames(GET_ROWNAMES(GET_DIMNAMES(X)),(N),(W)))
+# define MATCHCOLNAMES(X,N,W) (matchnames(GET_COLNAMES(GET_DIMNAMES(X)),(N),(W)))
 # define MATCH_CHAR_TO_ROWNAMES(X,N,A) (match_char_to_names(GET_ROWNAMES(GET_DIMNAMES(X)),(N),(A)))
 
 // lookup-table structure, as used internally
@@ -91,7 +91,7 @@
   return x;
 }
 
-static R_INLINE SEXP matchnames (SEXP x, SEXP names) {
+static R_INLINE SEXP matchnames (SEXP x, SEXP names, const char *where) {
   int nprotect = 0;
   int n = length(names);
   int *idx, k;
@@ -100,7 +100,10 @@
   PROTECT(index = match(x,names,0)); nprotect++;
   idx = INTEGER(index);
   for (k = 0; k < n; k++) {
-    if (idx[k]==0) error("variable '%s' not found",CHARACTER_DATA(STRING_ELT(nm,k)));
+    if (idx[k]==0) 
+      error("variable '%s' not found among the %s",
+	    CHARACTER_DATA(STRING_ELT(nm,k)),
+	    where);
     idx[k] -= 1;
   }
   UNPROTECT(nprotect);
@@ -132,7 +135,7 @@
   SEXP slotnames, index;
   PROTECT(slotnames = GET_SLOT(object,install(slot)));
   if (LENGTH(slotnames) > 0) {
-    PROTECT(index = matchnames(names,slotnames));
+    PROTECT(index = matchnames(names,slotnames,slot));
   } else {
     PROTECT(index = NEW_INTEGER(0));
   }

Modified: pkg/pomp/src/rmeasure.c
===================================================================
--- pkg/pomp/src/rmeasure.c	2014-06-09 16:30:30 UTC (rev 967)
+++ pkg/pomp/src/rmeasure.c	2014-06-09 16:30:39 UTC (rev 968)
@@ -163,7 +163,7 @@
 	    PROTECT(nm = GET_NAMES(ans)); nprotect++;
 	    use_names = !isNull(nm);
 	    if (use_names) {		// match names against names from data slot
-	      posn = INTEGER(PROTECT(matchnames(Onames,nm))); nprotect++;
+	      posn = INTEGER(PROTECT(matchnames(Onames,nm,"observables"))); nprotect++;
 	    } else {
 	      posn = 0;
 	    }

Modified: pkg/pomp/src/rprior.c
===================================================================
--- pkg/pomp/src/rprior.c	2014-06-09 16:30:30 UTC (rev 967)
+++ pkg/pomp/src/rprior.c	2014-06-09 16:30:39 UTC (rev 968)
@@ -80,7 +80,7 @@
 	  PROTECT(nm = GET_NAMES(ans)); nprotect++;
 	  use_names = !isNull(nm);
 	  if (use_names) {   // match names against names from params slot
-	    posn = INTEGER(PROTECT(matchnames(Pnames,nm))); nprotect++;
+	    posn = INTEGER(PROTECT(matchnames(Pnames,nm,"parameters"))); nprotect++;
 	  } else {
 	    posn = 0;
 	  }

Modified: pkg/pomp/src/skeleton.c
===================================================================
--- pkg/pomp/src/skeleton.c	2014-06-09 16:30:30 UTC (rev 967)
+++ pkg/pomp/src/skeleton.c	2014-06-09 16:30:39 UTC (rev 968)
@@ -67,7 +67,7 @@
 	PROTECT(nm = GET_NAMES(ans)); nprotect++;
 	use_names = !isNull(nm);
 	if (use_names) {
-	  posn = INTEGER(PROTECT(matchnames(Snames,nm))); nprotect++;
+	  posn = INTEGER(PROTECT(matchnames(Snames,nm,"state variables"))); nprotect++;
 	} else {
 	  posn = 0;
 	}

Modified: pkg/pomp/src/trajectory.c
===================================================================
--- pkg/pomp/src/trajectory.c	2014-06-09 16:30:30 UTC (rev 967)
+++ pkg/pomp/src/trajectory.c	2014-06-09 16:30:39 UTC (rev 968)
@@ -75,7 +75,7 @@
 	  PROTECT(nm = GET_NAMES(ans)); nprotect++;
 	  use_names = !isNull(nm);
 	  if (use_names) {
-	    posn = INTEGER(PROTECT(matchnames(Snames,nm))); nprotect++;
+	    posn = INTEGER(PROTECT(matchnames(Snames,nm,"state variables"))); nprotect++;
 	  }
 	  fs = REAL(AS_NUMERIC(ans));
 	  first = 0;
@@ -144,7 +144,7 @@
   PROTECT(zeronames = GET_SLOT(object,install("zeronames"))); nprotect++;
   nzeros = LENGTH(zeronames);
   if (nzeros > 0) {
-    zidx = INTEGER(PROTECT(matchnames(Snames,zeronames))); nprotect++;
+    zidx = INTEGER(PROTECT(matchnames(Snames,zeronames,"state variables"))); nprotect++;
   }
 
   // create array to store results



More information about the pomp-commits mailing list