[Pomp-commits] r19 - in pkg: inst/examples tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Jul 25 16:03:17 CEST 2008
Author: kingaa
Date: 2008-07-25 16:03:17 +0200 (Fri, 25 Jul 2008)
New Revision: 19
Added:
pkg/tests/examples.R
Modified:
pkg/inst/examples/logistic.R
pkg/inst/examples/rw2.R
pkg/inst/examples/sir.R
Log:
add a test of the examples in 'inst/examples' to the 'tests' directory
modify the sir.R example so that it attempts to build a shared-object library only if .Platform$OS.type=='unix'
Modified: pkg/inst/examples/logistic.R
===================================================================
--- pkg/inst/examples/logistic.R 2008-07-25 10:43:02 UTC (rev 18)
+++ pkg/inst/examples/logistic.R 2008-07-25 14:03:17 UTC (rev 19)
@@ -1,4 +1,4 @@
-library(pomp)
+require(pomp)
po <- pomp(
data=rbind(obs=rep(0,1000)),
Modified: pkg/inst/examples/rw2.R
===================================================================
--- pkg/inst/examples/rw2.R 2008-07-25 10:43:02 UTC (rev 18)
+++ pkg/inst/examples/rw2.R 2008-07-25 14:03:17 UTC (rev 19)
@@ -1,4 +1,4 @@
-library(pomp)
+require(pomp)
rw.rprocess <- function (params, xstart, times, ...) {
## this function simulates two independent random walks with intensities s1, s2
Modified: pkg/inst/examples/sir.R
===================================================================
--- pkg/inst/examples/sir.R 2008-07-25 10:43:02 UTC (rev 18)
+++ pkg/inst/examples/sir.R 2008-07-25 14:03:17 UTC (rev 19)
@@ -1,15 +1,5 @@
require(pomp)
-modelfile <- system.file("examples/sir.c",package="pomp")
-includedir <- system.file("include",package="pomp")
-lib <- system.file("libs/pomp.so",package="pomp")
-
-## compile the model into shared-object library
-system(paste("cp",modelfile,"."))
-system(paste("cp ",includedir,"/euler.h .",sep=""))
-system(paste("cp ",includedir,"/lookup_table.h .",sep=""))
-system(paste("R CMD SHLIB -o sir.so sir.c",lib))
-
## basis functions for the seasonality
tbasis <- seq(0,25,by=1/52)
basis <- periodic.bspline.basis(tbasis,nbasis=3)
@@ -131,50 +121,63 @@
}
)
-# alternatively, one can define the computationally intensive bits using native routines:
+## alternatively, one can define the computationally intensive bits using native routines:
## the C codes "sir_euler_simulator" and "sir_euler_density" are included in the "examples" directory (file "sir.c")
-po <- pomp(
- times=seq(1/52,4,by=1/52),
- data=rbind(measles=numeric(52*4)),
- t0=0,
- tcovar=tbasis,
- covar=basis,
- delta.t=1/52/20,
- statenames=c("S","I","R","cases","W","B","dW"),
- paramnames=c("gamma","mu","iota","beta1","beta.sd","pop"),
- covarnames=c("seas1"),
- zeronames=c("cases"),
- step.fun="sir_euler_simulator",
- rprocess=euler.simulate,
- dens.fun="sir_euler_density",
- dprocess=euler.density,
- skeleton="sir_ODE",
- PACKAGE="pomp",
- measurement.model=measles~binom(size=cases,prob=exp(rho)),
- initializer=function(params,t0,...){
- p <- exp(params)
- with(
- as.list(p),
- {
- fracs <- c(S.0,I.0,R.0)
- x0 <- c(
- round(pop*fracs/sum(fracs)), # make sure the three compartments sum to 'pop' initially
- rep(0,9) # zeros for 'cases', 'W', and the transition numbers
- )
- names(x0) <- c("S","I","R","cases","W","B","SI","SD","IR","ID","RD","dW")
- x0
- }
- )
- }
- )
-dyn.load("sir.so") # load the shared-object library
+if (.Platform$OS.type=='unix') {
-## simulate from the model
-tic <- Sys.time()
-x <- simulate(po,params=log(params),nsim=3)
-toc <- Sys.time()
-print(toc-tic)
-plot(x[[1]])
+ modelfile <- system.file("examples/sir.c",package="pomp")
+ includedir <- system.file("include",package="pomp")
+ lib <- system.file("libs/pomp.so",package="pomp")
-dyn.unload("sir.so")
+ ## compile the model into a shared-object library
+ system(paste("cp",modelfile,"."))
+ system(paste("cp ",includedir,"/pomp.h .",sep=""))
+ system(paste("R CMD SHLIB -o ./sir_example.so sir.c",lib))
+
+ po <- pomp(
+ times=seq(1/52,4,by=1/52),
+ data=rbind(measles=numeric(52*4)),
+ t0=0,
+ tcovar=tbasis,
+ covar=basis,
+ delta.t=1/52/20,
+ statenames=c("S","I","R","cases","W","B","dW"),
+ paramnames=c("gamma","mu","iota","beta1","beta.sd","pop"),
+ covarnames=c("seas1"),
+ zeronames=c("cases"),
+ step.fun="sir_euler_simulator",
+ rprocess=euler.simulate,
+ dens.fun="sir_euler_density",
+ dprocess=euler.density,
+ skeleton="sir_ODE",
+ PACKAGE="sir_example", ## name of the shared-object library
+ measurement.model=measles~binom(size=cases,prob=exp(rho)),
+ initializer=function(params,t0,...){
+ p <- exp(params)
+ with(
+ as.list(p),
+ {
+ fracs <- c(S.0,I.0,R.0)
+ x0 <- c(
+ round(pop*fracs/sum(fracs)), # make sure the three compartments sum to 'pop' initially
+ rep(0,9) # zeros for 'cases', 'W', and the transition numbers
+ )
+ names(x0) <- c("S","I","R","cases","W","B","SI","SD","IR","ID","RD","dW")
+ x0
+ }
+ )
+ }
+ )
+
+ dyn.load("sir_example.so") ## load the shared-object library
+
+ ## simulate from the model
+ tic <- Sys.time()
+ x <- simulate(po,params=log(params),nsim=3)
+ toc <- Sys.time()
+ print(toc-tic)
+
+ dyn.unload("sir_example.so")
+
+}
Added: pkg/tests/examples.R
===================================================================
--- pkg/tests/examples.R (rev 0)
+++ pkg/tests/examples.R 2008-07-25 14:03:17 UTC (rev 19)
@@ -0,0 +1,9 @@
+library(pomp)
+
+set.seed(47575684)
+
+examples <- list.files(path=system.file("examples",package="pomp"),pattern=".\\.R$",full.names=TRUE)
+
+for (e in examples) {
+ source(e,local=TRUE)
+}
More information about the pomp-commits
mailing list