[Pomp-commits] r1018 - in pkg/pomp: . R inst inst/examples man src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Dec 17 16:45:49 CET 2014
Author: kingaa
Date: 2014-12-17 16:45:48 +0100 (Wed, 17 Dec 2014)
New Revision: 1018
Removed:
pkg/pomp/inst/examples/parus.R
pkg/pomp/src/parus.c
Modified:
pkg/pomp/DESCRIPTION
pkg/pomp/R/aaa.R
pkg/pomp/R/example.R
pkg/pomp/inst/NEWS
pkg/pomp/inst/NEWS.Rd
pkg/pomp/man/example.Rd
Log:
- revamp pompExample facility
Modified: pkg/pomp/DESCRIPTION
===================================================================
--- pkg/pomp/DESCRIPTION 2014-12-10 17:12:14 UTC (rev 1017)
+++ pkg/pomp/DESCRIPTION 2014-12-17 15:45:48 UTC (rev 1018)
@@ -1,8 +1,8 @@
Package: pomp
Type: Package
Title: Statistical Inference for Partially Observed Markov Processes
-Version: 0.55-2
-Date: 2014-12-10
+Version: 0.56-1
+Date: 2014-12-16
Authors at R: c(person(given=c("Aaron","A."),family="King",
role=c("aut","cre"),email="kingaa at umich.edu"),
person(given=c("Edward","L."),family="Ionides",role=c("aut")),
Modified: pkg/pomp/R/aaa.R
===================================================================
--- pkg/pomp/R/aaa.R 2014-12-10 17:12:14 UTC (rev 1017)
+++ pkg/pomp/R/aaa.R 2014-12-17 15:45:48 UTC (rev 1018)
@@ -1,10 +1,12 @@
-## .onAttach <- function (...) {
-## version <- library(help=pomp)$info[[1L]]
-## version <- strsplit(version[pmatch("Version",version)]," ")[[1L]]
-## version <- version[nchar(version)>0][2L]
-## packageStartupMessage("This is pomp version ",version,"\n")
-## }
+.onAttach <- function (...) {
+ exampleDir <- getOption("pomp.examples")
+ pompExampleDir <- system.file("examples",package="pomp")
+ options(pomp.examples=c(exampleDir,pompExampleDir,recursive=TRUE))
+}
-if (!exists("paste0",where="package:base")) {
- paste0 <- function(...) paste(...,sep="")
+.onDetach <- function (...) {
+ exampleDir <- getOption("pomp.examples")
+ pompExampleDir <- system.file("examples",package="pomp")
+ exampleDir <- exampleDir[exampleDir!=pompExampleDir]
+ options(pomp.examples=exampleDir)
}
Modified: pkg/pomp/R/example.R
===================================================================
--- pkg/pomp/R/example.R 2014-12-10 17:12:14 UTC (rev 1017)
+++ pkg/pomp/R/example.R 2014-12-17 15:45:48 UTC (rev 1018)
@@ -1,22 +1,38 @@
-pompExample <- function (example, envir = .GlobalEnv) {
+pompExample <- function (example, ..., envir = .GlobalEnv) {
example <- as.character(substitute(example))
+ pomp.dir <- system.file("examples",package="pomp")
+ exampleDirs <- getOption("pomp.examples",default=pomp.dir)
+ names(exampleDirs) <- exampleDirs
if (example=="") {
- avlbl <- list.files(
- path=system.file("examples",package="pomp"),
- pattern=".+?R$"
- )
- avlbl <- gsub("\\.R$","",avlbl)
- avlbl
+ avlbl <- lapply(exampleDirs,list.files,pattern=".+?R$")
+ avlbl <- lapply(avlbl,function(x) gsub("\\.R$","",x))
+ for (dir in exampleDirs) {
+ cat("examples in ",dir,":\n",sep="")
+ print(avlbl[[dir]])
+ }
} else {
- file <- system.file(
- file.path("examples",paste(example,".R",sep="")),
- package="pomp"
- )
- objs <- source(file,local=TRUE)
- for (i in seq_along(objs$value)) {
- assign(objs$value[i],get(objs$value[i]),envir=envir)
+ evalEnv <- list2env(list(...))
+ file <- c(lapply(exampleDirs,list.files,
+ pattern=paste0(example,".R"),
+ full.names=TRUE),
+ recursive=TRUE)
+ if (length(file)>1) {
+ warning("using ",sQuote(file[1])," from ",sQuote(names(file)[1]))
}
- cat("newly created pomp object(s):\n",objs$value,"\n")
- invisible(NULL)
+ objs <- source(file[1],local=evalEnv)
+ if (is.null(envir)) {
+ obj <- setNames(lapply(objs$value,get,envir=evalEnv),objs$value)
+ } else if (is.environment(envir)) {
+ for (i in seq_along(objs$value)) {
+ assign(objs$value[i],
+ get(objs$value[i],envir=evalEnv),
+ envir=envir)
+ }
+ cat("newly created pomp object(s):\n",objs$value,"\n")
+ obj <- NULL
+ } else {
+ stop(sQuote("envir")," must be an environment or NULL")
+ }
+ invisible(obj)
}
}
Modified: pkg/pomp/inst/NEWS
===================================================================
--- pkg/pomp/inst/NEWS 2014-12-10 17:12:14 UTC (rev 1017)
+++ pkg/pomp/inst/NEWS 2014-12-17 15:45:48 UTC (rev 1018)
@@ -1,5 +1,11 @@
_N_e_w_s _f_o_r _p_a_c_k_a_g_e '_p_o_m_p'
+_C_h_a_n_g_e_s _i_n '_p_o_m_p' _v_e_r_s_i_o_n _0._5_6-_1:
+
+ • Revamped the ‘pompExample’ function. A search path for
+ example directories is now stored in global option
+ "pomp.examples".
+
_C_h_a_n_g_e_s _i_n '_p_o_m_p' _v_e_r_s_i_o_n _0._5_5-_1:
• New ‘values’ method extracts simulated probe values on
Modified: pkg/pomp/inst/NEWS.Rd
===================================================================
--- pkg/pomp/inst/NEWS.Rd 2014-12-10 17:12:14 UTC (rev 1017)
+++ pkg/pomp/inst/NEWS.Rd 2014-12-17 15:45:48 UTC (rev 1018)
@@ -1,5 +1,11 @@
\name{NEWS}
\title{News for package `pomp'}
+\section{Changes in \pkg{pomp} version 0.56-1}{
+ \itemize{
+ \item Revamped the \code{pompExample} function.
+ A search path for example directories is now stored in global option "pomp.examples".
+ }
+}
\section{Changes in \pkg{pomp} version 0.55-1}{
\itemize{
\item New \code{values} method extracts simulated probe values on \code{probed.pomp} object.
Deleted: pkg/pomp/inst/examples/parus.R
===================================================================
--- pkg/pomp/inst/examples/parus.R 2014-12-10 17:12:14 UTC (rev 1017)
+++ pkg/pomp/inst/examples/parus.R 2014-12-17 15:45:48 UTC (rev 1018)
@@ -1,74 +0,0 @@
-require(pomp)
-
-dat <- 'year,pop
-1960,148
-1961,258
-1962,185
-1963,170
-1964,267
-1965,239
-1966,196
-1967,132
-1968,167
-1969,186
-1970,128
-1971,227
-1972,174
-1973,177
-1974,137
-1975,172
-1976,119
-1977,226
-1978,166
-1979,161
-1980,199
-1981,306
-1982,206
-1983,350
-1984,214
-1985,175
-1986,211
-'
-
-dat <- read.csv(text=dat)
-
-pomp(
- data=dat,
- times="year",
- t0=1960,
- params=c(K=190,r=2.7,sigma=0.2,tau=0.05,N.0=148),
- rprocess=discrete.time.sim(
- step.fun="_parus_gompertz_simulator"
- ),
- rmeasure="_parus_lognormal_rmeasure",
- dmeasure="_parus_lognormal_dmeasure",
- skeleton="_parus_gompertz_skeleton",
- skeleton.type="map",
- paramnames=c("r","K","sigma","tau"),
- statenames=c("N"),
- obsnames=c("pop"),
- parameter.transform=function(params,...){
- exp(params)
- },
- parameter.inv.transform=function(params,...){
- log(params)
- }
- ) -> parusG
-
-pomp(
- parusG,
- rprocess=discrete.time.sim(
- step.fun="_parus_ricker_simulator"
- ),
- rmeasure="_parus_poisson_rmeasure",
- dmeasure="_parus_poisson_dmeasure",
- skeleton="_parus_ricker_skeleton",
- skeleton.type="map",
- paramnames=c("r","K","sigma","tau"),
- statenames=c("N"),
- obsnames=c("pop"),
- PACKAGE="pomp"
- ) -> parusR
-
-c("parusG","parusR")
-
Modified: pkg/pomp/man/example.Rd
===================================================================
--- pkg/pomp/man/example.Rd 2014-12-10 17:12:14 UTC (rev 1017)
+++ pkg/pomp/man/example.Rd 2014-12-17 15:45:48 UTC (rev 1018)
@@ -5,26 +5,37 @@
\code{pompExample} loads pre-built example \code{pomp} objects.
}
\usage{
-pompExample(example, envir = .GlobalEnv)
+pompExample(example, \dots, envir = .GlobalEnv)
}
\arguments{
\item{example}{
example to load given as a name or literal character string.
Evoked without an argument, \code{pompExample} lists all available examples.
}
+ \item{\dots}{
+ additional arguments define symbols in the environment within which the example code is executed.
+ }
\item{envir}{
the environment into which the objects should be loaded.
+ If \code{envir=NULL}, then the created objects are returned in a list.
}
}
+\details{
+ Directories in the the global option \code{pomp.examples} (set using \code{options()}) are searched for files named \file{example.R}.
+ If found, this file will be \code{source}d in a temporary environment.
+ Additional arguments to \code{pompExample} define variables within this environment and will therefore be available when the code in \file{example.R} is \code{source}d.
+}
\value{
- \code{pompExample} has the side effect of creating one or more \code{pomp} objects in the global workspace.
+ By default, \code{pompExample} has the side effect of creating one or more \code{pomp} objects in the global workspace.
+ If \code{envir=NULL}, there are no side effects; rather, the \code{pomp} objects are returned as a list.
}
\author{Aaron A. King \email{kingaa at umich dot edu}}
\examples{
pompExample()
pompExample(euler.sir)
pompExample("gompertz")
- file.show(system.file("include/pomp.h",package="pomp"))
+ pompExample(ricker,envir=NULL)
+ file.show(system.file("examples/bbs.R",package="pomp"))
}
\seealso{
\code{\link{blowflies}}, \code{\link{dacca}}, \code{\link{gompertz}},
Deleted: pkg/pomp/src/parus.c
===================================================================
--- pkg/pomp/src/parus.c 2014-12-10 17:12:14 UTC (rev 1017)
+++ pkg/pomp/src/parus.c 2014-12-17 15:45:48 UTC (rev 1018)
@@ -1,75 +0,0 @@
-// dear emacs, please treat this as -*- C++ -*-
-
-#include <Rmath.h>
-
-#include "pomp.h"
-
-#define R (p[parindex[0]]) // growth rate
-#define K (p[parindex[1]]) // carrying capacity
-#define SIGMA (p[parindex[2]]) // process noise level
-#define TAU (p[parindex[3]]) // measurement noise level
-
-#define POP (y[obsindex[0]])
-#define N (x[stateindex[0]])
-#define NPRIME (f[stateindex[0]])
-
-void _parus_lognormal_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) {
- *lik = dlnorm(POP,log(N),TAU,give_log);
-}
-
-void _parus_lognormal_rmeasure (double *y, double *x, double *p,
- int *obsindex, int *stateindex, int *parindex, int *covindex,
- int ncovars, double *covars, double t) {
- POP = rlnorm(log(N),TAU);
-}
-
-void _parus_poisson_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) {
- *lik = dpois(POP,N,give_log);
-}
-
-void _parus_poisson_rmeasure (double *y, double *x, double *p,
- int *obsindex, int *stateindex, int *parindex, int *covindex,
- int ncovars, double *covars, double t) {
- POP = rpois(N);
-}
-
-void _parus_gompertz_simulator (double *x, const double *p,
- const int *stateindex, const int *parindex, const int *covindex,
- int covdim, const double *covar,
- double t, double dt)
-{
- double S = exp(-R*dt);
- double eps = (SIGMA > 0.0) ? exp(rnorm(0,SIGMA)) : 1.0;
- N = pow(K,(1-S))*pow(N,S)*eps;
-}
-
-// the deterministic skeleton
-void _parus_gompertz_skeleton (double *f, double *x, const double *p,
- const int *stateindex, const int *parindex, const int *covindex,
- int covdim, const double *covar, double t)
-{
- double dt = 1.0;
- double S = exp(-R*dt);
- NPRIME = pow(K,(1-S))*pow(N,S);
-}
-
-// Ricker model with log-normal process noise
-void _parus_ricker_simulator (double *x, const double *p,
- const int *stateindex, const int *parindex, const int *covindex,
- int covdim, const double *covar,
- double t, double dt)
-{
- double e = (SIGMA > 0.0) ? rnorm(0,SIGMA) : 0.0;
- N = exp(log(N)+R*(1-N/K)+e);
-}
-
-void _parus_ricker_skeleton (double *f, double *x, const double *p,
- const int *stateindex, const int *parindex, const int *covindex,
- int covdim, const double *covar, double t)
-{
- NPRIME = exp(log(N)+R*(1-N/K));
-}
More information about the pomp-commits
mailing list