From f777c46a086d3903c937a3475f18d1f642c1b560 Mon Sep 17 00:00:00 2001 From: "Aaron A. King" Date: Sun, 29 Dec 2024 11:54:55 -0500 Subject: [PATCH] new append_data function --- DESCRIPTION | 4 ++-- NAMESPACE | 3 +++ R/bake.R | 38 ++++++++++++++++++++++++++++- inst/NEWS | 12 ++++++++++ inst/NEWS.Rd | 11 +++++++++ man/bake.Rd | 18 +++++++++++++- tests/save.R | 24 +++++++++++++++++++ tests/save.Rout.save | 57 ++++++++++++++++++++++++++++++++++++++++++++ 8 files changed, 163 insertions(+), 4 deletions(-) create mode 100644 tests/save.R create mode 100644 tests/save.Rout.save diff --git a/DESCRIPTION b/DESCRIPTION index 2d36aeb2..75ffa3be 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: pomp Type: Package Title: Statistical Inference for Partially Observed Markov Processes -Version: 6.0.3.1 -Date: 2024-12-28 +Version: 6.0.4.0 +Date: 2024-12-29 Authors@R: c(person(given=c("Aaron","A."),family="King",role=c("aut","cre"),email="kingaa@umich.edu",comment=c(ORCID="0000-0001-6159-3207")), person(given=c("Edward","L."),family="Ionides",role="aut",comment=c(ORCID="0000-0002-4190-0174")) , person(given="Carles",family="Bretó",role="aut",comment=c(ORCID="0000-0003-4695-4902")), diff --git a/NAMESPACE b/NAMESPACE index f30ed5f1..854b892c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -14,6 +14,7 @@ S3method(as.data.frame,probed_pomp) S3method(as.data.frame,wpfilterd_pomp) S3method(c,Pomp) export(Csnippet) +export(append_data) export(as_pomp) export(bake) export(blowflies1) @@ -147,6 +148,8 @@ exportMethods(wpfilter) import(methods) importFrom(coda,mcmc) importFrom(coda,mcmc.list) +importFrom(data.table,fread) +importFrom(data.table,fwrite) importFrom(data.table,rbindlist) importFrom(deSolve,diagnostics) importFrom(deSolve,ode) diff --git a/R/bake.R b/R/bake.R index 9f456fdd..c70e2ebc 100644 --- a/R/bake.R +++ b/R/bake.R @@ -35,7 +35,8 @@ ##' Therefore, avoid using \sQuote{pomp} objects as dependencies in \code{bake} and \code{stew}. ##' @param file Name of the archive file in which the result will be stored or retrieved, as appropriate. ##' For \code{bake}, this will contain a single object and hence be an RDS file (extension \sQuote{rds}); -##' for \code{stew}, this will contain one or more named objects and hence be an RDA file (extension \sQuote{rda}). +##' for \code{stew}, this will contain one or more named objects and hence be an RDA file (extension \sQuote{rda}); +##' for \code{append_data}, this will be a CSV file. ##' @param dir Directory holding archive files; ##' by default, this is the current working directory. ##' This can also be set using the global option \code{pomp_archive_dir}. @@ -333,3 +334,38 @@ freeze <- function (expr, } val } + +##' @rdname bake +##' @param data data frame +##' @param overwrite logical; if \code{TRUE}, \code{data} are written to \code{file}, replacing any existing contents. +##' If \code{FALSE}, the \code{data} is appended to the existing contents of \code{file}. +##' @return +##' \code{append_data} returns a data frame containing the new contents of \code{file}, invisibly. +##' @importFrom data.table fread fwrite rbindlist +##' @export +append_data <- function ( + data, + file, + overwrite = FALSE, + dir = getOption("pomp_archive_dir",getwd()) +) { + tryCatch({ + file <- create_path(dir,file) + append <- file.exists(file) && !as.logical(overwrite) + if (append) { + data <- rbindlist( + list( + fread(file=file), + data + ), + fill=TRUE, + use.names=TRUE + ) + } + fwrite(data,file=file) + }, + error=function (e) { + pStop(who="append_data",conditionMessage(e)) + }) + invisible(data) +} diff --git a/inst/NEWS b/inst/NEWS index b8d79efb..b626c001 100644 --- a/inst/NEWS +++ b/inst/NEWS @@ -1,5 +1,17 @@ _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 _6._0._4: + + • The new function ‘append_data’ appends a data frame to an + existing CSV file (creating the file if it does not exist). + This facilitates keeping a database of parameter-space + explorations. + +_C_h_a_n_g_e_s _i_n '_p_o_m_p' _v_e_r_s_i_o_n _6._0._3: + + • The new function ‘eeulermultinom’ gives the expectation of an + Euler-multinomial random variable. + _C_h_a_n_g_e_s _i_n '_p_o_m_p' _v_e_r_s_i_o_n _6._0._2: • The ‘save.states’ option to ‘pfilter’ has changed. See diff --git a/inst/NEWS.Rd b/inst/NEWS.Rd index 68efdfac..e5b3f559 100644 --- a/inst/NEWS.Rd +++ b/inst/NEWS.Rd @@ -1,5 +1,16 @@ \name{NEWS} \title{News for package `pomp'} +\section{Changes in \pkg{pomp} version 6.0.4}{ + \itemize{ + \item The new function \code{append_data} appends a data frame to an existing CSV file (creating the file if it does not exist). + This facilitates keeping a database of parameter-space explorations. + } +} +\section{Changes in \pkg{pomp} version 6.0.3}{ + \itemize{ + \item The new function \code{eeulermultinom} gives the expectation of an Euler-multinomial random variable. + } +} \section{Changes in \pkg{pomp} version 6.0.2}{ \itemize{ \item The \code{save.states} option to \code{pfilter} has changed. diff --git a/man/bake.Rd b/man/bake.Rd index 5c0c4dfe..e94b1540 100644 --- a/man/bake.Rd +++ b/man/bake.Rd @@ -5,6 +5,7 @@ \alias{bake} \alias{stew} \alias{freeze} +\alias{append_data} \title{Tools for reproducible computations} \usage{ bake( @@ -39,11 +40,19 @@ freeze( envir = parent.frame(), enclos = if (is.list(envir) || is.pairlist(envir)) parent.frame() else baseenv() ) + +append_data( + data, + file, + overwrite = FALSE, + dir = getOption("pomp_archive_dir", getwd()) +) } \arguments{ \item{file}{Name of the archive file in which the result will be stored or retrieved, as appropriate. For \code{bake}, this will contain a single object and hence be an RDS file (extension \sQuote{rds}); -for \code{stew}, this will contain one or more named objects and hence be an RDA file (extension \sQuote{rda}).} +for \code{stew}, this will contain one or more named objects and hence be an RDA file (extension \sQuote{rda}); +for \code{append_data}, this will be a CSV file.} \item{expr}{Expression to be evaluated.} @@ -84,6 +93,11 @@ If it does not exist, this directory will be created (with a message).} Specifies the enclosure, i.e., where \R looks for objects not found in \code{envir}. This can be \code{NULL} (interpreted as the base package environment, \code{\link[base]{baseenv}()}) or an environment.} + +\item{data}{data frame} + +\item{overwrite}{logical; if \code{TRUE}, \code{data} are written to \code{file}, replacing any existing contents. +If \code{FALSE}, the \code{data} is appended to the existing contents of \code{file}.} } \value{ \code{bake} returns the value of the evaluated expression \code{expr}. @@ -104,6 +118,8 @@ The time required for execution is also recorded. \code{bake} stores this in the \dQuote{system.time} attribute of the archived \R object; \code{stew} does so in a hidden variable named \code{.system.time}. The timing is obtained using \code{\link{system.time}}. + +\code{append_data} returns a data frame containing the new contents of \code{file}, invisibly. } \description{ Archiving of computations and control of the random-number generator. diff --git a/tests/save.R b/tests/save.R new file mode 100644 index 00000000..f134b251 --- /dev/null +++ b/tests/save.R @@ -0,0 +1,24 @@ +library(dplyr) +library(tidyr) +library(pomp) +set.seed(1800076828) +ricker() -> po +options(pomp_archive_dir=tempdir()) + +simulate(po,nsim=20) |> + coef() |> + melt() |> + pivot_wider() |> + append_data("tmp.csv",overwrite=TRUE) + +simulate(po,nsim=20,times=1:3) |> + as.data.frame() |> + rename(.id=.L1) |> + append_data("tmp.csv") -> dat + +data.table::fread(file.path(tempdir(),"tmp.csv")) -> dat1 + +stopifnot(all.equal(dat,dat1)) + +try(append_data("bob",file="tmp.csv")) +try(append_data("bob",file="tmp.csv",overwrite=TRUE)) diff --git a/tests/save.Rout.save b/tests/save.Rout.save new file mode 100644 index 00000000..77dda44f --- /dev/null +++ b/tests/save.Rout.save @@ -0,0 +1,57 @@ + +R version 4.4.2 (2024-10-31) -- "Pile of Leaves" +Copyright (C) 2024 The R Foundation for Statistical Computing +Platform: x86_64-pc-linux-gnu + +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. + + Natural language support but running in an English locale + +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(dplyr) + +Attaching package: 'dplyr' + +The following objects are masked from 'package:stats': + + filter, lag + +The following objects are masked from 'package:base': + + intersect, setdiff, setequal, union + +> library(tidyr) +> library(pomp) +> set.seed(1800076828) +> ricker() -> po +> options(pomp_archive_dir=tempdir()) +> +> simulate(po,nsim=20) |> ++ coef() |> ++ melt() |> ++ pivot_wider() |> ++ append_data("tmp.csv",overwrite=TRUE) +> +> simulate(po,nsim=20,times=1:3) |> ++ as.data.frame() |> ++ rename(.id=.L1) |> ++ append_data("tmp.csv") -> dat +> +> data.table::fread(file.path(tempdir(),"tmp.csv")) -> dat1 +> +> stopifnot(all.equal(dat,dat1)) +> +> try(append_data("bob",file="tmp.csv")) +Error : in 'append_data': Item 2 of input is not a data.frame, data.table or list +> try(append_data("bob",file="tmp.csv",overwrite=TRUE)) +Error : in 'append_data': is.list(x) is not TRUE +>