Issue #221: Add marginal model (#426)

* Add cohort model template * Fix to previous commit (name as cohort_model) * Generate simulated cohort data * Add unweighted and weighted direct models * Thinking about custom family for pcd function * functions component of stanvars * Add transformed parameters for cohort model * Progress on implementing PCD model * Set q as vector * Get rid of params input * This would work, apart from it's the CDF. For the PMF need to import many primarycensored functions.. * Almost working with "import all functions" strategy * Wrap up on attempt * Rename to marginal model * Move towards single wrap function with others imported * Just running into some C++ errors.. * This doesn't change anything * Move to marginal model name and lint * Create aggregate data inside model conversion function for now * First draft on moving marginal_model into functions * Run document * Tests working up to valid Stan code * Regex version of marginal model * Use prep_marginal_obs * Improve assert for marginal model * Add pkgdown and document * Clean up scratch implementation * remove scratch file * update data format, formula, and family * update stan code * basic working version * add transformm data methods * start exploring the ebola example * add a helper to find meaningful relative_obs_times * get the full ebola vignette working with new variable requirements * improve return messages * update approx vignette * get ebole vignette passing by checking pp and related inputs * add marginal model integration tests * expand post processing tests * add marginal model * use the right transform data keyword * add ... pass through to make constructors correct * fix .summarise_n_by_formula test so error message is as expected * drop not required .row_id * check using ... properly * make the progress messages prettier for reducing data complexit: * check post process tests again * add a test for the specific transform data method * add some tests for the generic transform data method * put transform data tests in the correct folder * add a news update * change vignette language to talk about marginal model * update the FAQ to use the marginal variables * call it transformed_data not trans_data * change the error message to make it clear its a epidist limitation * update stan docs * Update NEWS.md * Update NEWS.md Co-authored-by: Adam Howes <[email protected]> * Update NEWS.md Co-authored-by: Adam Howes <[email protected]> * Update inst/stan/latent_model/functions.stan Co-authored-by: Adam Howes <[email protected]> * Update setup.R --------- Co-authored-by: Sam <[email protected]>
epinowcast · Dec 3, 2024 · ce41f42 · ce41f42
1 parent f9e2fc8
commit ce41f42
Show file tree

Hide file tree

Showing 36 changed files with 1,248 additions and 187 deletions.
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -17,4 +17,5 @@
 ^pkgdown$
 ^vignettes/approx-inference\.Rmd$
 ^vignettes/ebola\.Rmd$
+^vignettes/faq\.Rmd$
 ^\.lintr$
diff --git a/NAMESPACE b/NAMESPACE
@@ -6,26 +6,34 @@ S3method(add_mean_sd,lognormal_samples)
 S3method(as_epidist_latent_model,epidist_linelist_data)
 S3method(as_epidist_linelist_data,data.frame)
 S3method(as_epidist_linelist_data,default)
+S3method(as_epidist_marginal_model,epidist_linelist_data)
 S3method(as_epidist_naive_model,epidist_linelist_data)
 S3method(assert_epidist,default)
 S3method(assert_epidist,epidist_latent_model)
 S3method(assert_epidist,epidist_linelist_data)
+S3method(assert_epidist,epidist_marginal_model)
 S3method(assert_epidist,epidist_naive_model)
 S3method(epidist_family_model,default)
 S3method(epidist_family_model,epidist_latent_model)
+S3method(epidist_family_model,epidist_marginal_model)
 S3method(epidist_family_param,default)
 S3method(epidist_family_prior,default)
 S3method(epidist_family_prior,lognormal)
 S3method(epidist_formula_model,default)
 S3method(epidist_formula_model,epidist_latent_model)
+S3method(epidist_formula_model,epidist_marginal_model)
 S3method(epidist_model_prior,default)
 S3method(epidist_model_prior,epidist_latent_model)
 S3method(epidist_stancode,default)
 S3method(epidist_stancode,epidist_latent_model)
+S3method(epidist_stancode,epidist_marginal_model)
+S3method(epidist_transform_data_model,default)
+S3method(epidist_transform_data_model,epidist_marginal_model)
 export(Gamma)
 export(add_mean_sd)
 export(as_epidist_latent_model)
 export(as_epidist_linelist_data)
+export(as_epidist_marginal_model)
 export(as_epidist_naive_model)
 export(assert_epidist)
 export(bf)
@@ -42,12 +50,16 @@ export(epidist_gen_posterior_predict)
 export(epidist_model_prior)
 export(epidist_prior)
 export(epidist_stancode)
+export(epidist_transform_data)
+export(epidist_transform_data_model)
 export(is_epidist_latent_model)
 export(is_epidist_linelist_data)
+export(is_epidist_marginal_model)
 export(is_epidist_naive_model)
 export(lognormal)
 export(new_epidist_latent_model)
 export(new_epidist_linelist_data)
+export(new_epidist_marginal_model)
 export(new_epidist_naive_model)
 export(predict_delay_parameters)
 export(predict_dpar)
@@ -78,14 +90,18 @@ importFrom(cli,cli_abort)
 importFrom(cli,cli_alert_info)
 importFrom(cli,cli_inform)
 importFrom(cli,cli_warn)
+importFrom(dplyr,across)
 importFrom(dplyr,bind_cols)
 importFrom(dplyr,bind_rows)
 importFrom(dplyr,filter)
 importFrom(dplyr,full_join)
+importFrom(dplyr,group_by)
 importFrom(dplyr,mutate)
 importFrom(dplyr,select)
+importFrom(dplyr,summarise)
 importFrom(lubridate,days)
 importFrom(lubridate,is.timepoint)
+importFrom(purrr,map_chr)
 importFrom(purrr,map_dbl)
 importFrom(stats,Gamma)
 importFrom(stats,as.formula)

diff --git a/NEWS.md b/NEWS.md
@@ -2,19 +2,26 @@
 
 Development version of `epidist`.
 
+## Models
+
+- Added a marginalised likelihood model based on `primarycensored`. This can be specified using `as_epidist_marginal_model()`. This is currently limited to Weibull, log-normal, and gamma distributions with uniform primary censoring but this will be generalised in future releases. See #426.
+- Added user settable primary event priors to the latent model. See #474.
+- Added a marginalised likelihood to the latent model. See #474.
+
 ## Package
 
 - Remove the default method for `epidist()`. See #473.
 - Added `enforce_presence` argument to `epidist_prior()` to allow for priors to be
   specified if they do not match existing parameters. See #474.
 - Added a `merge` argument to `epidist_prior()` to allow for not merging user and package priors. See #474.
-- Added user settable primary event priors to the latent model. See #474.
-- Added a marginalised likelihood to the latent model. See #474.
 - Generalised the stan reparametrisation feature to work across all distributions without manual specification by generating stan code with `brms` and then extracting the reparameterisation. See #474.
+- Added a `transform_data` S3 method to allow for data to be transformed for specific models. This is specifically useful for the marginal model at the moment as it allows reducing the data to its unique strata. See #474.
 
 ## Documentation
 
 - Brings the README into line with `epinowcast` standards. See #467.
+- Switched over to using the marginal model as default in documentation. See #426.
+- Added helper functions for new variables to avoid code duplication in vignettes. See #426.
 
 # epidist 0.1.0
 

diff --git a/R/epidist.R b/R/epidist.R
@@ -38,16 +38,20 @@ epidist <- function(data, formula = mu ~ 1,
   epidist_formula <- epidist_formula(
     data = data, family = epidist_family, formula = formula
   )
+  transformed_data <- epidist_transform_data(
+    data, epidist_family, epidist_formula
+  )
   epidist_prior <- epidist_prior(
-    data = data, family = epidist_family, formula = epidist_formula, prior,
+    data = transformed_data, family = epidist_family,
+    formula = epidist_formula, prior,
     merge = merge_priors
   )
   epidist_stancode <- epidist_stancode(
-    data = data, family = epidist_family, formula = epidist_formula
+    data = transformed_data, family = epidist_family, formula = epidist_formula
   )
   fit <- fn(
     formula = epidist_formula, family = epidist_family, prior = epidist_prior,
-    stanvars = epidist_stancode, data = data, ...
+    stanvars = epidist_stancode, data = transformed_data, ...
   )
   class(fit) <- c(class(fit), "epidist_fit")
   return(fit)

diff --git a/R/latent_model.R b/R/latent_model.R
@@ -1,21 +1,23 @@
 #' Convert an object to an `epidist_latent_model` object
 #'
 #' @param data An object to be converted to the class `epidist_latent_model`
+#' @param ... Additional arguments passed to methods.
 #' @family latent_model
 #' @export
-as_epidist_latent_model <- function(data) {
+as_epidist_latent_model <- function(data, ...) {
   UseMethod("as_epidist_latent_model")
 }
 
 
 #' The latent model method for `epidist_linelist_data` objects
 #'
 #' @param data An `epidist_linelist_data` object
+#' @param ... Not used in this method.
 #' @method as_epidist_latent_model epidist_linelist_data
 #' @family latent_model
 #' @autoglobal
 #' @export
-as_epidist_latent_model.epidist_linelist_data <- function(data) {
+as_epidist_latent_model.epidist_linelist_data <- function(data, ...) {
   assert_epidist(data)
   data <- data |>
     mutate(
@@ -38,10 +40,11 @@ as_epidist_latent_model.epidist_linelist_data <- function(data) {
 #' Class constructor for `epidist_latent_model` objects
 #'
 #' @param data An object to be set with the class `epidist_latent_model`
+#' @param ... Additional arguments passed to methods.
 #' @returns An object of class `epidist_latent_model`
 #' @family latent_model
 #' @export
-new_epidist_latent_model <- function(data) {
+new_epidist_latent_model <- function(data, ...) {
   class(data) <- c("epidist_latent_model", class(data))
   return(data)
 }