[Pomp-commits] r726 - in pkg/pomp: . R demo man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Fri Jun 1 15:55:15 CEST 2012


Author: kingaa
Date: 2012-06-01 15:55:15 +0200 (Fri, 01 Jun 2012)
New Revision: 726

Modified:
   pkg/pomp/DESCRIPTION
   pkg/pomp/R/builder.R
   pkg/pomp/demo/gompertz.R
   pkg/pomp/man/builder.Rd
Log:
- fix incorrect error messages in 'pompBuilder'
- allow 'pompBuilder' to deal with covariates


Modified: pkg/pomp/DESCRIPTION
===================================================================
--- pkg/pomp/DESCRIPTION	2012-05-29 18:12:40 UTC (rev 725)
+++ pkg/pomp/DESCRIPTION	2012-06-01 13:55:15 UTC (rev 726)
@@ -2,7 +2,7 @@
 Type: Package
 Title: Statistical inference for partially observed Markov processes
 Version: 0.42-5
-Date: 2012-05-29
+Date: 2012-06-01
 Author: Aaron A. King, Edward L. Ionides, Carles Breto, Steve Ellner, Bruce Kendall, Helen Wearing, Matthew J. Ferrari, Michael Lavine, Daniel C. Reuman
 Maintainer: Aaron A. King <kingaa at umich.edu>
 URL: http://pomp.r-forge.r-project.org

Modified: pkg/pomp/R/builder.R
===================================================================
--- pkg/pomp/R/builder.R	2012-05-29 18:12:40 UTC (rev 725)
+++ pkg/pomp/R/builder.R	2012-06-01 13:55:15 UTC (rev 726)
@@ -20,17 +20,28 @@
 }
 
 pompBuilder <- function (data, times, t0, name,
-                         statenames, paramnames,
+                         statenames, paramnames, tcovar, covar,
                          rmeasure, dmeasure, step.fn, step.fn.delta.t,
                          skeleton, skeleton.type, skelmap.delta.t = 1,
                          parameter.transform, parameter.inv.transform,
                          ..., link = TRUE) {
+  if (!is.data.frame(data)) stop(sQuote("data")," must be a data-frame")
   obsnames <- names(data)
   obsnames <- setdiff(obsnames,times)
+  if (!missing(covar)) {
+    if (!is.data.frame(covar)) stop(sQuote("covar")," must be a data-frame")
+    covarnames <- colnames(covar)
+    covarnames <- setdiff(covarnames,tcovar)
+  } else {
+    covar <- matrix(data=0,nrow=0,ncol=0)
+    tcovar <- numeric(0)
+    covarnames <- character(0)
+  }
   solib <- pompCBuilder(
                         name=name,
                         statenames=statenames,
                         paramnames=paramnames,
+                        covarnames=covarnames,
                         obsnames=obsnames,
                         rmeasure=rmeasure,
                         dmeasure=dmeasure,
@@ -58,6 +69,9 @@
        obsnames=obsnames,
        statenames=statenames,
        paramnames=paramnames,
+       covarnames=covarnames,
+       tcovar=tcovar,
+       covar=covar,
        ...
        )
 }
@@ -85,7 +99,7 @@
                file="/* pomp model file: {%name%} */\n\n#include <pomp.h>\n#include <R_ext/Rdynload.h>\n\n",
                rmeasure="\nvoid {%name%}_rmeasure (double *__y, double *__x, double *__p, int *__obsindex, int *__stateindex, int *__parindex, int *__covindex, int __ncovars, double *__covars, double t)\n{\n",
                dmeasure= "\nvoid {%name%}_dmeasure (double *__lik, double *__y, double *__x, double *__p, int give_log, int *__obsindex, int *__stateindex, int *__parindex, int *__covindex, int __ncovars, double *__covars, double t)\n{\n",
-               step.fn="\nvoid {%name%}_stepfn (double *__x, const double *__p, const int *__stateindex, const int *__parindex, const int *__covindex, int __covdim, const double *__covar, double t, double dt)\n{\n",
+               step.fn="\nvoid {%name%}_stepfn (double *__x, const double *__p, const int *__stateindex, const int *__parindex, const int *__covindex, int __covdim, const double *__covars, double t, double dt)\n{\n",
                skeleton="\nvoid {%name%}_skelfn (double *__f, double *__x, double *__p, int *__stateindex, int *__parindex, int *__covindex, int __ncovars, double *__covars, double t)\n{\n",
                parameter.transform="\nvoid {%name%}_par_trans (double *__pt, double *__p, int *__parindex)\n{\n",
                parameter.inv.transform="\nvoid {%name%}_par_untrans (double *__pt, double *__p, int *__parindex)\n{\n"
@@ -114,13 +128,14 @@
                     )
 
 
-pompCBuilder <- function (name, statenames, paramnames, obsnames, rmeasure, dmeasure,
+pompCBuilder <- function (name, statenames, paramnames, covarnames, obsnames, rmeasure, dmeasure,
                           step.fn, skeleton, parameter.transform, parameter.inv.transform)
 {
   if (missing(name)) stop(sQuote("name")," must be supplied");
-  if (missing(statenames)) stop(sQuote("name")," must be supplied");
-  if (missing(paramnames)) stop(sQuote("name")," must be supplied");
-  if (missing(obsnames)) stop(sQuote("name")," must be supplied");
+  if (missing(statenames)) stop(sQuote("statenames")," must be supplied");
+  if (missing(paramnames)) stop(sQuote("paramnames")," must be supplied");
+  if (missing(obsnames)) stop(sQuote("obsnames")," must be supplied");
+  if (missing(covarnames)) stop(sQuote("covarnames")," must be supplied");
 
   mpt <- missing(parameter.transform)
   mpit <- missing(parameter.inv.transform)
@@ -131,6 +146,7 @@
   name <- cleanForC(name)
   statenames <- cleanForC(statenames)
   paramnames <- cleanForC(paramnames)
+  covarnames <- cleanForC(covarnames)
   obsnames <- cleanForC(obsnames)
 
   modelfile <- paste0(name,".c")
@@ -148,6 +164,9 @@
   for (v in seq_along(paramnames)) {
     cat(file=out,render(define$var,variable=paramnames[v],ptr='__p',ilist='__parindex',index=v-1))
   }
+  for (v in seq_along(covarnames)) {
+    cat(file=out,render(define$var,variable=covarnames[v],ptr='__covars',ilist='__covindex',index=v-1))
+  }
   for (v in seq_along(statenames)) {
     cat(file=out,render(define$var,variable=statenames[v],ptr='__x',ilist='__stateindex',index=v-1))
   }
@@ -205,6 +224,9 @@
   for (v in seq_along(paramnames)) {
     cat(file=out,render(undefine$var,variable=paramnames[v]))
   }
+  for (v in seq_along(covarnames)) {
+    cat(file=out,render(undefine$var,variable=covarnames[v]))
+  }
   for (v in seq_along(statenames)) {
     cat(file=out,render(undefine$var,variable=statenames[v]))
   }

Modified: pkg/pomp/demo/gompertz.R
===================================================================
--- pkg/pomp/demo/gompertz.R	2012-05-29 18:12:40 UTC (rev 725)
+++ pkg/pomp/demo/gompertz.R	2012-06-01 13:55:15 UTC (rev 726)
@@ -51,7 +51,7 @@
      }
      ) -> gompertz
 
-## Now code up the Gompertz example using native routines results in much faster computations.
+## Now code up the Gompertz example using native routines: results in much faster computations.
 
 dmeas <- "
     lik = dlnorm(Y,log(X),tau,give_log);

Modified: pkg/pomp/man/builder.Rd
===================================================================
--- pkg/pomp/man/builder.Rd	2012-05-29 18:12:40 UTC (rev 725)
+++ pkg/pomp/man/builder.Rd	2012-06-01 13:55:15 UTC (rev 726)
@@ -6,6 +6,7 @@
 }
 \usage{
 pompBuilder(data, times, t0, name, statenames, paramnames, 
+            tcovar, covar,
             rmeasure, dmeasure, step.fn, step.fn.delta.t,
             skeleton, skeleton.type, skelmap.delta.t = 1,
             parameter.transform, parameter.inv.transform,
@@ -23,6 +24,11 @@
   \item{statenames, paramnames}{
     names of state-variables and parameters, respectively
   }
+  \item{tcovar, covar}{
+    optional.
+    \code{covar} is a data-frame containing covariates (variables in columns, timepoints in rows);
+    \code{tcovar} is the name of the column containing time.
+  }
   \item{rmeasure, dmeasure}{
     C codes implementing the measurement model
   }



More information about the pomp-commits mailing list