[Pomp-commits] r1020 - pkg/pompExamples/inst/examples

[noreply at r-forge.r-project.org]

Author: kingaa
Date: 2014-12-17 20:12:06 +0100 (Wed, 17 Dec 2014)
New Revision: 1020

Modified:
   pkg/pompExamples/inst/examples/parus.R
Log:
- improved parus example

Modified: pkg/pompExamples/inst/examples/parus.R
===================================================================
--- pkg/pompExamples/inst/examples/parus.R	2014-12-17 19:12:00 UTC (rev 1019)
+++ pkg/pompExamples/inst/examples/parus.R	2014-12-17 19:12:06 UTC (rev 1020)
@@ -1,16 +1,5 @@
 require(pomp)
 
-proc.avail <- c("Gompertz","Ricker")
-meas.avail <- c("lognormal","Poisson","negbin")
-
-if (!exists("proc",where=environment()))
-  stop("choose a process model: proc = ",sQuote(proc.avail))
-if (!exists("meas",where=environment()))
-  stop("choose a measurement model: meas = ",sQuote(meas.avail))
-
-proc <- proc.avail[pmatch(proc,proc.avail)]
-meas <- meas.avail[pmatch(meas,meas.avail)]
-
 dat <- 'year,pop
 1960,148
 1961,258
@@ -43,48 +32,57 @@
 
 dat <- read.csv(text=dat)
 
-pomp(
-     data=dat,
-     times="year",
-     t0=1960,
-     params=c(K=190,r=2.7,sigma=0.2,theta=0.05,N.0=148),
-     rprocess=discrete.time.sim(
-       step.fun=switch(proc,
-         Gompertz="_parus_gompertz_simulator",
-         Ricker="_parus_ricker_simulator",
-         stop("unrecognized value of ",sQuote("proc"))
+parus.example <- function (proc = c("Gompertz","Ricker"),
+                           meas = c("lognormal","Poisson","negbin")) {
+
+  proc <- match.arg(proc)
+  meas <- match.arg(meas)
+
+  pomp(
+       data=dat,
+       times="year",
+       t0=1960,
+       params=c(K=190,r=2.7,sigma=0.2,theta=0.05,N.0=148),
+       rprocess=discrete.time.sim(
+         step.fun=switch(proc,
+           Gompertz="_parus_gompertz_simulator",
+           Ricker="_parus_ricker_simulator",
+           stop("unrecognized value of ",sQuote("proc"))
+           ),
+         delta.t=1
          ),
-       delta.t=1
-       ),
-     skeleton=switch(proc,
+       skeleton=switch(proc,
          Gompertz="_parus_gompertz_skeleton",
          Ricker="_parus_ricker_skeleton",
          stop("unrecognized value of ",sQuote("proc"))
          ),
-     skeleton.type="map",
-     skelmap.delta.t=1,
-     rmeasure=switch(meas,
-       lognormal="_parus_lognormal_rmeasure",
-       Poisson="_parus_poisson_rmeasure",
-       negbin="_parus_nbinom_rmeasure",
-       stop("unrecognized value of ",sQuote("meas"))
-       ),
-     dmeasure=switch(meas,
-       lognormal="_parus_lognormal_dmeasure",
-       Poisson="_parus_poisson_dmeasure",
-       negbin="_parus_nbinom_dmeasure",
-       stop("unrecognized value of ",sQuote("meas"))
-       ),
-     paramnames=c("r","K","sigma","theta"),
-     statenames=c("N"),
-     obsnames=c("pop"),
-     parameter.transform=function(params,...){
-       exp(params)
-     },
-     parameter.inv.transform=function(params,...){
-       log(params)
-     },
-     PACKAGE="pompExamples"
-     ) -> parus
+       skeleton.type="map",
+       skelmap.delta.t=1,
+       rmeasure=switch(meas,
+         lognormal="_parus_lognormal_rmeasure",
+         Poisson="_parus_poisson_rmeasure",
+         negbin="_parus_nbinom_rmeasure",
+         stop("unrecognized value of ",sQuote("meas"))
+         ),
+       dmeasure=switch(meas,
+         lognormal="_parus_lognormal_dmeasure",
+         Poisson="_parus_poisson_dmeasure",
+         negbin="_parus_nbinom_dmeasure",
+         stop("unrecognized value of ",sQuote("meas"))
+         ),
+       paramnames=c("r","K","sigma","theta"),
+       statenames=c("N"),
+       obsnames=c("pop"),
+       parameter.transform=function(params,...){
+         exp(params)
+       },
+       parameter.inv.transform=function(params,...){
+         log(params)
+       },
+       PACKAGE="pompExamples"
+       )
+}
 
+parus <- parus.example(proc=proc,meas=meas)
+
 c("parus")