From 6c7d8eb68e7081404f1b645e7fbc2f52c3de37a0 Mon Sep 17 00:00:00 2001 From: "Aaron A. King" Date: Sat, 14 Jan 2023 12:44:50 -0500 Subject: [PATCH] format argument for 'obs' and 'states' --- DESCRIPTION | 4 +-- R/filter_mean.R | 2 +- R/obs.R | 23 ++++++++++++++--- R/saved_states.R | 12 ++++----- R/states.R | 19 +++++++++++--- inst/NEWS | 6 +++++ inst/NEWS.Rd | 6 +++++ man/cond_logLik.Rd | 2 +- man/eff_sample_size.Rd | 2 +- man/filter_mean.Rd | 2 +- man/filter_traj.Rd | 2 +- man/forecast.Rd | 2 +- man/obs.Rd | 6 +++-- man/pred_mean.Rd | 2 +- man/pred_var.Rd | 2 +- man/states.Rd | 6 +++-- tests/helpers.R | 17 ++++++++++++- tests/helpers.Rout.save | 55 ++++++++++++++++++++++++++++++++--------- 18 files changed, 131 insertions(+), 39 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 2d40411ed..65cbd3201 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: pomp Type: Package Title: Statistical Inference for Partially Observed Markov Processes -Version: 4.6.1.1 -Date: 2023-01-13 +Version: 4.6.2.0 +Date: 2023-01-14 Authors@R: c(person(given=c("Aaron","A."),family="King", role=c("aut","cre"),email="kingaa@umich.edu"), person(given=c("Edward","L."),family="Ionides",role=c("aut")), diff --git a/R/filter_mean.R b/R/filter_mean.R index 0cbd7697e..23b6f9147 100644 --- a/R/filter_mean.R +++ b/R/filter_mean.R @@ -19,7 +19,7 @@ ##' ##' @param object result of a filtering computation ##' @param vars optional character; names of variables -##' @param format format of the returned object. +##' @param format format of the returned object ##' @param ... ignored ##' NULL diff --git a/R/obs.R b/R/obs.R index ff2b84d92..f296e0fb3 100644 --- a/R/obs.R +++ b/R/obs.R @@ -37,12 +37,14 @@ setMethod( ##' @rdname obs ##' @param object an object of class \sQuote{pomp}, or of a class extending \sQuote{pomp} ##' @param vars names of variables to retrieve +##' @param format format of the returned object ##' @param \dots ignored ##' @export setMethod( "obs", signature=signature(object="pomp"), - definition=function (object, vars, ...) { + definition=function (object, vars, ..., + format = c("array", "data.frame")) { varnames <- rownames(object@data) if (missing(vars)) vars <- varnames @@ -50,17 +52,30 @@ setMethod( pStop("obs","some elements of ", sQuote("vars")," correspond to no observed variable.") y <- object@data[vars,,drop=FALSE] - dimnames(y) <- setNames(list(vars,NULL),c("variable","time")) + dimnames(y) <- setNames(list(vars,NULL),c("variable",object@timename)) + format <- match.arg(format) + if (format == "data.frame") { + y <- data.frame(time=time(object),t(y)) + names(y)[1L] <- object@timename + } y } ) ##' @rdname obs +##' @importFrom plyr rbind.fill ##' @export setMethod( "obs", signature=signature(object="listie"), - definition=function (object, vars, ...) { - lapply(object,obs,vars=vars) + definition=function (object, vars, ..., + format = c("array", "data.frame")) { + format <- match.arg(format) + y <- lapply(object,obs,vars=vars,format=format,...) + if (format == "data.frame") { + rbind.fill(y,.id=".id") + } else { + y + } } ) diff --git a/R/saved_states.R b/R/saved_states.R index a353ee86f..e638b8e74 100644 --- a/R/saved_states.R +++ b/R/saved_states.R @@ -63,20 +63,20 @@ setMethod( } else if ("weights" %in% names(object@saved.states)) { s <- melt(object@saved.states$states) w <- melt(object@saved.states$weights) - s$time <- time(object)[as.integer(s$.L1)] - w$time <- time(object)[as.integer(w$.L1)] + s[[object@timename]] <- time(object)[as.integer(s$.L1)] + w[[object@timename]] <- time(object)[as.integer(w$.L1)] w$variable <- ".log.weight" x <- rbind( - s[,c("time",".id","variable","value")], - w[,c("time",".id","variable","value")] + s[,c(object@timename,".id","variable","value")], + w[,c(object@timename,".id","variable","value")] ) x <- x[order(x$time,x$.id),] row.names(x) <- NULL x } else { s <- melt(object@saved.states) - s$time <- time(object)[as.integer(s$.L1)] - s <- s[,c("time",".id","variable","value")] + s[[object@timename]] <- time(object)[as.integer(s$.L1)] + s <- s[,c(object@timename,".id","variable","value")] row.names(s) <- NULL s } diff --git a/R/states.R b/R/states.R index a9fa63df6..2edf7fa41 100644 --- a/R/states.R +++ b/R/states.R @@ -40,7 +40,8 @@ setMethod( setMethod( "states", signature=signature(object="pomp"), - definition=function (object, vars, ...) { + definition=function (object, vars, ..., + format = c("array", "data.frame")) { if (length(object@states)==0) { x <- array(NA_real_,dim=c(0,length(object@times)), dimnames=setNames(list(NULL,NULL),c("variable",object@timename))) @@ -53,6 +54,11 @@ setMethod( x <- object@states[vars,,drop=FALSE] dimnames(x) <- setNames(list(vars,NULL),c("variable",object@timename)) } + format <- match.arg(format) + if (format == "data.frame") { + x <- data.frame(time=time(object),t(x)) + names(x)[1L] <- object@timename + } x } ) @@ -63,7 +69,14 @@ setMethod( setMethod( "states", signature=signature(object="listie"), - definition=function (object, vars, ...) { - lapply(object,states,vars=vars) + definition=function (object, vars, ..., + format = c("array", "data.frame")) { + format <- match.arg(format) + x <- lapply(object,states,vars=vars,format=format,...) + if (format == "data.frame") { + rbind.fill(x,.id=".id") + } else { + x + } } ) diff --git a/inst/NEWS b/inst/NEWS index dbe5225b6..aa68a5e42 100644 --- a/inst/NEWS +++ b/inst/NEWS @@ -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 _4._6._2: + + • The ‘states’ and ‘obs’ methods take a new optional argument, + ‘format’. Setting ‘format="data.frame"’ causes the method to + return the states or data in a convenient data-frame format. + _C_h_a_n_g_e_s _i_n '_p_o_m_p' _v_e_r_s_i_o_n _4._6._1: • When ‘melt’ is applied to a list, the identifier variable is diff --git a/inst/NEWS.Rd b/inst/NEWS.Rd index 42a493a4b..272a9fdfa 100644 --- a/inst/NEWS.Rd +++ b/inst/NEWS.Rd @@ -1,5 +1,11 @@ \name{NEWS} \title{News for package `pomp'} +\section{Changes in \pkg{pomp} version 4.6.2}{ + \itemize{ + \item The \code{states} and \code{obs} methods take a new optional argument, \code{format}. + Setting \code{format="data.frame"} causes the method to return the states or data in a convenient data-frame format. + } +} \section{Changes in \pkg{pomp} version 4.6.1}{ \itemize{ \item When \code{melt} is applied to a list, the identifier variable is now \sQuote{.L\code{x}}, where \code{x} denotes the level. diff --git a/man/cond_logLik.Rd b/man/cond_logLik.Rd index 2f1f948e4..a7b6f5c17 100644 --- a/man/cond_logLik.Rd +++ b/man/cond_logLik.Rd @@ -24,7 +24,7 @@ \item{...}{ignored} -\item{format}{format of the returned object.} +\item{format}{format of the returned object} } \value{ The numerical value of the conditional log likelihood. diff --git a/man/eff_sample_size.Rd b/man/eff_sample_size.Rd index be9c8184e..cfaf5efc0 100644 --- a/man/eff_sample_size.Rd +++ b/man/eff_sample_size.Rd @@ -20,7 +20,7 @@ \item{...}{ignored} -\item{format}{format of the returned object.} +\item{format}{format of the returned object} } \description{ Estimate the effective sample size of a Monte Carlo computation. diff --git a/man/filter_mean.Rd b/man/filter_mean.Rd index 4df213c81..bf834a195 100644 --- a/man/filter_mean.Rd +++ b/man/filter_mean.Rd @@ -20,7 +20,7 @@ \item{...}{ignored} -\item{format}{format of the returned object.} +\item{format}{format of the returned object} } \description{ The mean of the filtering distribution diff --git a/man/filter_traj.Rd b/man/filter_traj.Rd index 4f6be9a58..95024ee7f 100644 --- a/man/filter_traj.Rd +++ b/man/filter_traj.Rd @@ -25,7 +25,7 @@ \item{...}{ignored} -\item{format}{format of the returned object.} +\item{format}{format of the returned object} } \description{ Drawing from the smoothing distribution diff --git a/man/forecast.Rd b/man/forecast.Rd index cae917ffb..717ff0c9e 100644 --- a/man/forecast.Rd +++ b/man/forecast.Rd @@ -21,7 +21,7 @@ forecast(object, ...) \item{vars}{optional character; names of variables} -\item{format}{format of the returned object.} +\item{format}{format of the returned object} } \description{ Mean of the one-step-ahead forecasting distribution. diff --git a/man/obs.Rd b/man/obs.Rd index 22d7b717b..24490bdc4 100644 --- a/man/obs.Rd +++ b/man/obs.Rd @@ -9,9 +9,9 @@ \alias{obs,listie-method} \title{obs} \usage{ -\S4method{obs}{pomp}(object, vars, ...) +\S4method{obs}{pomp}(object, vars, ..., format = c("array", "data.frame")) -\S4method{obs}{listie}(object, vars, ...) +\S4method{obs}{listie}(object, vars, ..., format = c("array", "data.frame")) } \arguments{ \item{object}{an object of class \sQuote{pomp}, or of a class extending \sQuote{pomp}} @@ -19,6 +19,8 @@ \item{vars}{names of variables to retrieve} \item{\dots}{ignored} + +\item{format}{format of the returned object} } \description{ Extract the data array from a \sQuote{pomp} object. diff --git a/man/pred_mean.Rd b/man/pred_mean.Rd index bc13b87d1..83273b7ab 100644 --- a/man/pred_mean.Rd +++ b/man/pred_mean.Rd @@ -19,7 +19,7 @@ \item{...}{ignored} -\item{format}{format of the returned object.} +\item{format}{format of the returned object} } \description{ The mean of the prediction distribution diff --git a/man/pred_var.Rd b/man/pred_var.Rd index 00ab14461..c045d5d5a 100644 --- a/man/pred_var.Rd +++ b/man/pred_var.Rd @@ -16,7 +16,7 @@ \item{...}{ignored} -\item{format}{format of the returned object.} +\item{format}{format of the returned object} } \description{ The variance of the prediction distribution diff --git a/man/states.Rd b/man/states.Rd index 12cdbd252..8617446de 100644 --- a/man/states.Rd +++ b/man/states.Rd @@ -9,9 +9,9 @@ \alias{states,listie-method} \title{Latent states} \usage{ -\S4method{states}{pomp}(object, vars, ...) +\S4method{states}{pomp}(object, vars, ..., format = c("array", "data.frame")) -\S4method{states}{listie}(object, vars, ...) +\S4method{states}{listie}(object, vars, ..., format = c("array", "data.frame")) } \arguments{ \item{object}{an object of class \sQuote{pomp}, or of a class extending \sQuote{pomp}} @@ -19,6 +19,8 @@ \item{vars}{names of variables to retrieve} \item{...}{ignored} + +\item{format}{format of the returned object} } \description{ Extract the latent states from a \sQuote{pomp} object. diff --git a/tests/helpers.R b/tests/helpers.R index 066ea4d63..fe3dbdc6f 100644 --- a/tests/helpers.R +++ b/tests/helpers.R @@ -1,6 +1,9 @@ set.seed(901772384) -library(pomp) +suppressPackageStartupMessages({ + library(pomp) + library(tidyr) +}) try(eff_sample_size()) try(eff_sample_size("bob")) @@ -40,9 +43,21 @@ logLik("bob") try(states()) try(states("bob")) +ou2() |> + states(format="d") |> + head() +c(A=ou2(),B=gompertz()) |> + states(format="d") |> + head() try(obs()) try(obs("bob")) +ou2() |> + obs(format="d") |> + head() +c(A=ou2(),B=gompertz()) |> + obs(format="d") |> + head() try(melt()) melt("bob") diff --git a/tests/helpers.Rout.save b/tests/helpers.Rout.save index bbc5a94b2..3558b29ec 100644 --- a/tests/helpers.Rout.save +++ b/tests/helpers.Rout.save @@ -7,8 +7,6 @@ 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. @@ -19,15 +17,10 @@ Type 'q()' to quit R. > set.seed(901772384) > -> library(pomp) - -Welcome to pomp! - -As of version 4.6, no user-visible pomp function has a name that -includes a dot ('.'). Function names have been changed to replace the -dot with an underscore ('_'). For more information, see the pomp blog: -https://kingaa.github.io/pomp/blog.html. - +> suppressPackageStartupMessages({ ++ library(pomp) ++ library(tidyr) ++ }) > > try(eff_sample_size()) Error : in 'eff_sample_size': 'object' is a required argument. @@ -94,11 +87,51 @@ Error : in 'logLik': 'object' is a required argument. Error : in 'states': 'object' is a required argument. > try(states("bob")) Error : 'states' is undefined for '"object"' of class 'character'. +> ou2() |> ++ states(format="d") |> ++ head() + time x1 x2 +1 1 -3.7184616 4.249533 +2 2 0.9403927 6.843546 +3 3 -0.3725648 7.592267 +4 4 5.8085324 6.490249 +5 5 5.6054356 1.835443 +6 6 7.3546052 -1.566206 +> c(A=ou2(),B=gompertz()) |> ++ states(format="d") |> ++ head() + time x1 x2 X +1 1 -3.7184616 4.249533 NA +2 2 0.9403927 6.843546 NA +3 3 -0.3725648 7.592267 NA +4 4 5.8085324 6.490249 NA +5 5 5.6054356 1.835443 NA +6 6 7.3546052 -1.566206 NA > > try(obs()) Error : in 'obs': 'object' is a required argument. > try(obs("bob")) Error : 'obs' is undefined for '"object"' of class 'character'. +> ou2() |> ++ obs(format="d") |> ++ head() + time y1 y2 +1 1 -4.051293 4.7806442 +2 2 1.834630 6.2733019 +3 3 -1.317003 7.5558688 +4 4 6.640487 5.7299615 +5 5 6.575312 1.5614843 +6 6 7.540323 0.1756402 +> c(A=ou2(),B=gompertz()) |> ++ obs(format="d") |> ++ head() + time y1 y2 Y +1 1 -4.051293 4.7806442 NA +2 2 1.834630 6.2733019 NA +3 3 -1.317003 7.5558688 NA +4 4 6.640487 5.7299615 NA +5 5 6.575312 1.5614843 NA +6 6 7.540323 0.1756402 NA > > try(melt()) Error : in 'melt': 'data' is a required argument.