Updates s3 construction to be closer to best practice (#441)

* merge changes * overhaul class system and object assertion * get setup script running and prune down class requirements to what is actually needed * remove temporary function * remove test that doesn't do anything * check vignettes * minor tweaks to package family org * rename without epidist prefix * fix file.paths * rename and update functionality for linelist handling * catch changed family name * add lubridate * check date tiem suing lubrdiate * update namespace * flip test to working * fix CRAN notes * fix doc missing * fix R chunk start * rename models * rename models * export stanvar * update cmdstan model check * update package familes * check new tests
epinowcast · Nov 15, 2024 · c835f5f · c835f5f
1 parent b899cdb
commit c835f5f
Show file tree

Hide file tree

Showing 66 changed files with 1,135 additions and 799 deletions.
diff --git a/.github/workflows/check-cmdstan.yaml b/.github/workflows/check-cmdstan.yaml
@@ -62,13 +62,12 @@ jobs:
 
       - name: Compile model and check syntax
         run: |
-          dummy_obs <- dplyr::tibble(case = 1L, ptime = 1, stime = 2,
-            delay_daily = 1, delay_lwr = 1, delay_upr = 2, ptime_lwr = 1,
-            ptime_upr = 2, stime_lwr = 1, stime_upr = 2, obs_time = 100,
-            censored = "interval", censored_obs_time = 10, ptime_daily = 1,
-            stime_daily = 1
+          dummy_obs <- dplyr::tibble(
+            pdate_lwr = as.Date("2020-01-01"),
+            sdate_lwr = as.Date("2020-02-01")
           )
-          dummy_obs <- epidist::as_latent_individual(dummy_obs)
+          dummy_obs <- epidist::as_epidist_linelist_data(dummy_obs)
+          dummy_obs <- epidist::as_epidist_latent_model(dummy_obs)
           stancode <- epidist::epidist(
             data = dummy_obs, fn = brms::make_stancode
           )

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -32,7 +32,9 @@ Imports:
     cli,
     checkmate,
     rstan (>= 2.26.0),
-    dplyr
+    dplyr,
+    tibble,
+    lubridate
 Suggests:
     bookdown,
     testthat (>= 3.0.0),
@@ -41,7 +43,6 @@ Suggests:
     gt,
     knitr,
     roxyglobals,
-    tibble,
     bayesplot,
     tidyr,
     posterior,
@@ -51,8 +52,7 @@ Suggests:
     modelr,
     patchwork,
     cmdstanr,
-    priorsense
-LinkingTo: 
+    priorsense,
     BH (>= 1.66.0),
     Rcpp (>= 0.12.0),
     RcppEigen (>= 0.3.3.3.0)

diff --git a/NAMESPACE b/NAMESPACE
@@ -3,29 +3,31 @@
 S3method(add_mean_sd,default)
 S3method(add_mean_sd,gamma_samples)
 S3method(add_mean_sd,lognormal_samples)
-S3method(as_direct_model,data.frame)
-S3method(as_latent_individual,epidist_linelist)
+S3method(as_epidist_latent_model,epidist_linelist_data)
+S3method(as_epidist_linelist_data,data.frame)
+S3method(as_epidist_linelist_data,default)
+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_naive_model)
 S3method(epidist,default)
 S3method(epidist_family_model,default)
-S3method(epidist_family_model,epidist_latent_individual)
+S3method(epidist_family_model,epidist_latent_model)
 S3method(epidist_family_prior,default)
 S3method(epidist_family_prior,lognormal)
 S3method(epidist_family_reparam,default)
 S3method(epidist_family_reparam,gamma)
 S3method(epidist_formula_model,default)
-S3method(epidist_formula_model,epidist_latent_individual)
+S3method(epidist_formula_model,epidist_latent_model)
 S3method(epidist_model_prior,default)
 S3method(epidist_stancode,default)
-S3method(epidist_stancode,epidist_latent_individual)
-S3method(epidist_validate_data,default)
-S3method(epidist_validate_data,epidist_linelist)
-S3method(epidist_validate_model,default)
-S3method(epidist_validate_model,epidist_direct_model)
-S3method(epidist_validate_model,epidist_latent_individual)
+S3method(epidist_stancode,epidist_latent_model)
 export(add_mean_sd)
-export(as_direct_model)
-export(as_epidist_linelist)
-export(as_latent_individual)
+export(as_epidist_latent_model)
+export(as_epidist_linelist_data)
+export(as_epidist_naive_model)
+export(assert_epidist)
 export(epidist)
 export(epidist_diagnostics)
 export(epidist_family)
@@ -37,11 +39,12 @@ export(epidist_formula_model)
 export(epidist_model_prior)
 export(epidist_prior)
 export(epidist_stancode)
-export(epidist_validate_data)
-export(epidist_validate_model)
-export(is_direct_model)
-export(is_epidist_linelist)
-export(is_latent_individual)
+export(is_epidist_latent_model)
+export(is_epidist_linelist_data)
+export(is_epidist_naive_model)
+export(new_epidist_latent_model)
+export(new_epidist_linelist_data)
+export(new_epidist_naive_model)
 export(observe_process)
 export(predict_delay_parameters)
 export(predict_dpar)
@@ -52,18 +55,27 @@ export(simulate_uniform_cases)
 import(ggplot2)
 importFrom(brms,bf)
 importFrom(brms,prior)
+importFrom(brms,stanvar)
 importFrom(checkmate,assert_class)
 importFrom(checkmate,assert_data_frame)
+importFrom(checkmate,assert_date)
 importFrom(checkmate,assert_factor)
 importFrom(checkmate,assert_integer)
 importFrom(checkmate,assert_names)
 importFrom(checkmate,assert_numeric)
 importFrom(checkmate,assert_true)
 importFrom(cli,cli_abort)
+importFrom(cli,cli_alert_info)
 importFrom(cli,cli_inform)
 importFrom(cli,cli_warn)
+importFrom(dplyr,bind_cols)
 importFrom(dplyr,filter)
+importFrom(dplyr,full_join)
 importFrom(dplyr,mutate)
 importFrom(dplyr,select)
+importFrom(lubridate,days)
+importFrom(lubridate,is.timepoint)
 importFrom(stats,as.formula)
 importFrom(stats,setNames)
+importFrom(tibble,tibble)
+importFrom(utils,hasName)
diff --git a/R/assert_epidist.R b/R/assert_epidist.R
@@ -0,0 +1,21 @@
+#' Validation for epidist objects
+#'
+#' @param data Object to validate
+#' @param ... Additional arguments
+#' @return NULL invisibly
+#' @export
+#' @family assert
+assert_epidist <- function(data, ...) {
+  UseMethod("assert_epidist")
+}
+
+#' @export
+#' @family assert
+assert_epidist.default <- function(data, ...) {
+  cli_abort(
+    c(
+      "!" = "The input needs to be a valid epidist object.",
+      "i" = "Please convert to epidist object first using as_epidist_<class>()"
+    )
+  )
+}
diff --git a/R/direct_model.R b/R/direct_model.R
diff --git a/R/epidist.R b/R/epidist.R
@@ -36,7 +36,7 @@ epidist <- function(data, formula, family, prior, fn, ...) {
 epidist.default <- function(data, formula = mu ~ 1,
                             family = "lognormal", prior = NULL,
                             fn = brms::brm, ...) {
-  epidist_validate_model(data)
+  assert_epidist(data)
   epidist_family <- epidist_family(data, family)
   epidist_formula <- epidist_formula(
     data = data, family = epidist_family, formula = formula

diff --git a/R/family.R b/R/family.R
@@ -9,7 +9,7 @@
 #' @family family
 #' @export
 epidist_family <- function(data, family = "lognormal", ...) {
-  epidist_validate_model(data)
+  assert_epidist(data)
   family <- brms:::validate_family(family)
   class(family) <- c(family$family, class(family))
   family <- .add_dpar_info(family)

diff --git a/R/formula.R b/R/formula.R
@@ -11,7 +11,7 @@
 #' @family formula
 #' @export
 epidist_formula <- function(data, family, formula, ...) {
-  epidist_validate_model(data)
+  assert_epidist(data)
   formula <- brms:::validate_formula(formula, data = data, family = family)
   formula <- .make_intercepts_explicit(formula)
   formula <- epidist_formula_model(data, formula)

diff --git a/R/globals.R b/R/globals.R
@@ -2,7 +2,7 @@
 
 utils::globalVariables(c(
   "samples", # <epidist_diagnostics>
-  "woverlap", # <epidist_stancode.epidist_latent_individual>
+  "woverlap", # <epidist_stancode.epidist_latent_model>
   "rlnorm", # <simulate_secondary>
   "prior_new", # <.replace_prior>
   "source_new", # <.replace_prior>