new append_data function

kingaa · Dec 29, 2024 · f777c46 · f777c46
1 parent eeb4b5c
commit f777c46
Show file tree

Hide file tree

Showing 8 changed files with 163 additions and 4 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
diff --git a/tests/save.R 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
@@ -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
+>