[Pomp-commits] r531 - in pkg: data inst/data-R tests

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

Author: kingaa
Date: 2011-08-08 18:25:54 +0200 (Mon, 08 Aug 2011)
New Revision: 531

Added:
   pkg/tests/verhulst.R
   pkg/tests/verhulst.Rout.save
Modified:
   pkg/data/verhulst.rda
   pkg/inst/data-R/verhulst.R
Log:
- re-code verhulst example with more exemplary style.
- include a new unit-test in tests/verhulst.R


Modified: pkg/data/verhulst.rda
===================================================================
(Binary files differ)

Modified: pkg/inst/data-R/verhulst.R
===================================================================
--- pkg/inst/data-R/verhulst.R	2011-08-02 17:28:12 UTC (rev 530)
+++ pkg/inst/data-R/verhulst.R	2011-08-08 16:25:54 UTC (rev 531)
@@ -7,38 +7,42 @@
               t0=0,
               rprocess=euler.sim(
                 step.fun=function(x,t,params,delta.t,...){
-                  with(
-                       as.list(c(x,params)),
-                       rnorm(
-                             n=1,
-                             mean=n+r*n*(1-n/K)*delta.t,
-                             sd=sigma*n*sqrt(delta.t)
-                             )
-                       )
+                  r <- params["r"]
+                  K <- params["K"]
+                  sigma <- params["sigma"]
+                  n <- x["n"]
+                  rnorm(
+                        n=1,
+                        mean=n+r*n*(1-n/K)*delta.t,
+                        sd=sigma*n*sqrt(delta.t)
+                        )
                 },
                 delta.t=0.01
                 ),
               dprocess=onestep.dens(
                 dens.fun=function(x1,x2,t1,t2,params,log,...){
                   delta.t <- t2-t1
-                  with(
-                       as.list(c(x1,params)),
-                       dnorm(
-                             x=x2['n'],
-                             mean=n+r*n*(1-n/K)*delta.t,
-                             sd=sigma*n*sqrt(delta.t),
-                             log=log
-                             )
-                       )
+                  r <- params["r"]
+                  K <- params["K"]
+                  sigma <- params["sigma"]
+                  n <- x1["n"]
+                  dnorm(
+                        x=x2["n"],
+                        mean=n+r*n*(1-n/K)*delta.t,
+                        sd=sigma*n*sqrt(delta.t),
+                        log=log
+                        )
                 }
                 ),
               measurement.model=obs~lnorm(meanlog=log(n),sdlog=log(1+tau)),
               skeleton.type="vectorfield",
               skeleton=function(x,t,params,...){
-                with(
-                     as.list(c(x,params)),
-                     r*n*(1-n/K)
-                     )
+                r <- params["r"]
+                K <- params["K"]
+                n <- x["n"]
+                f <- r*n*(1-n/K)
+                names(f) <- "n"
+                f
               }
               ),
          params=c(

Added: pkg/tests/verhulst.R
===================================================================
--- pkg/tests/verhulst.R	                        (rev 0)
+++ pkg/tests/verhulst.R	2011-08-08 16:25:54 UTC (rev 531)
@@ -0,0 +1,11 @@
+library(pomp)
+
+data(verhulst)
+
+tail(as(verhulst,"data.frame"))
+tail(as.data.frame(verhulst))
+
+coef(verhulst,c("n.0","sigma")) <- c(100,0.2)
+time(verhulst) <- 1:100
+
+tail(as.data.frame(simulate(verhulst,seed=1066L)))

Added: pkg/tests/verhulst.Rout.save
===================================================================
--- pkg/tests/verhulst.Rout.save	                        (rev 0)
+++ pkg/tests/verhulst.Rout.save	2011-08-08 16:25:54 UTC (rev 531)
@@ -0,0 +1,54 @@
+
+R version 2.13.1 (2011-07-08)
+Copyright (C) 2011 The R Foundation for Statistical Computing
+ISBN 3-900051-07-0
+Platform: x86_64-unknown-linux-gnu (64-bit)
+
+R is free software and comes with ABSOLUTELY NO WARRANTY.
+You are welcome to redistribute it under certain conditions.
+Type 'license()' or 'licence()' for distribution details.
+
+R is a collaborative project with many contributors.
+Type 'contributors()' for more information and
+'citation()' on how to cite R or R packages in publications.
+
+Type 'demo()' for some demos, 'help()' for on-line help, or
+'help.start()' for an HTML browser interface to help.
+Type 'q()' to quit R.
+
+> library(pomp)
+Loading required package: mvtnorm
+Loading required package: subplex
+Loading required package: deSolve
+> 
+> data(verhulst)
+> 
+> tail(as(verhulst,"data.frame"))
+      time       obs         n
+995   99.5 14051.372 12361.973
+996   99.6 10764.397  9093.707
+997   99.7  8359.591  8168.390
+998   99.8  8337.105  8730.532
+999   99.9  8322.998  8511.592
+1000 100.0  8327.300  9127.382
+> tail(as.data.frame(verhulst))
+      time       obs         n
+995   99.5 14051.372 12361.973
+996   99.6 10764.397  9093.707
+997   99.7  8359.591  8168.390
+998   99.8  8337.105  8730.532
+999   99.9  8322.998  8511.592
+1000 100.0  8327.300  9127.382
+> 
+> coef(verhulst,c("n.0","sigma")) <- c(100,0.2)
+> time(verhulst) <- 1:100
+> 
+> tail(as.data.frame(simulate(verhulst,seed=1066L)))
+    time       obs         n
+95    95 11528.048 10993.019
+96    96  7829.730  9218.963
+97    97  9483.337  9642.360
+98    98  9819.607  8914.544
+99    99  8753.751  9082.258
+100  100  9202.150  9452.477
+>