Issue #221: Add marginal model

.Rbuildignore

@@ -17,4 +17,5 @@
 ^pkgdown$
 ^vignettes/approx-inference\.Rmd$
 ^vignettes/ebola\.Rmd$
+^vignettes/faq\.Rmd$
 ^\.lintr$

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)

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
 

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)

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)
 }