Impletement epidist_validate as S3 generic

NAMESPACE

@@ -10,6 +10,8 @@ S3method(epidist_prior,default)
 S3method(epidist_prior,epidist_latent_individual)
 S3method(epidist_stancode,default)
 S3method(epidist_stancode,epidist_latent_individual)
+S3method(epidist_validate,default)
+S3method(epidist_validate,epidist_latent_individual)
 export(add_natural_scale_mean_sd)
 export(as_latent_individual)
 export(calculate_censor_delay)
@@ -26,6 +28,7 @@ export(epidist_formula)
 export(epidist_prior)
 export(epidist_stan_chunk)
 export(epidist_stancode)
+export(epidist_validate)
 export(epidist_version_stanvar)
 export(event_to_incidence)
 export(extract_lognormal_draws)
@@ -53,7 +56,6 @@ export(simulate_secondary)
 export(simulate_uniform_cases)
 export(summarise_draws)
 export(summarise_variable)
-export(validate_latent_individual)
 import(brms)
 import(cmdstanr)
 import(data.table)
@@ -63,6 +65,7 @@ importFrom(checkmate,assert_int)
 importFrom(checkmate,assert_names)
 importFrom(checkmate,assert_numeric)
 importFrom(posterior,as_draws_df)
+importFrom(rstan,lookup)
 importFrom(stats,as.formula)
 importFrom(stats,ecdf)
 importFrom(stats,integrate)

R/defaults.R

@@ -1,3 +1,16 @@
+#' Default method for data validation
+#'
+#' @inheritParams epidist_validate
+#' @param ... Additional arguments for method.
+#' @family defaults
+#' @export
+epidist_validate.default <- function(data, ...) {
+  stop(
+    "No epidist_formula method implemented for the class ", class(data), "\n",
+    "See methods(epidist_validate) for available methods"
+  )
+}
+
 #' Default method for defining a model specific formula
 #'
 #' @inheritParams epidist_formula
@@ -61,6 +74,7 @@ epidist_stancode.default <- function(data, ...) {
 epidist.default <- function(data, formula = epidist_formula(data),
                             family = epidist_family(data),
                             prior = epidist_prior(data), fn = brms::brm, ...) {
+  epidist_validate(data)
   stancode <- epidist_stancode(data = data, family = family)
   fit <- fn(
     formula = formula, family = family, prior = prior, stanvars = stancode,

R/generics.R

@@ -1,3 +1,11 @@
+#' Validate
+#'
+#' @family generics
+#' @export
+epidist_validate <- function(data) {
+  UseMethod("epidist_validate")
+}
+
 #' Define a model specific formula
 #'
 #' @param data A dataframe to be used for modelling.

R/latent_individual.R

@@ -61,7 +61,7 @@ as_latent_individual.data.frame <- function(data) {
   if (nrow(data) > 1) {
     data <- data[, id := as.factor(id)]
   }
-  validate_latent_individual(data)
+  epidist_validate(data)
   return(data)
 }
 
@@ -75,9 +75,10 @@ as_latent_individual.data.frame <- function(data) {
 #' @param data A `data.frame` or `data.table` containing line list data
 #' @importFrom checkmate assert_data_frame assert_names assert_int
 #' assert_numeric
+#' @method epidist_validate epidist_latent_individual
 #' @family latent_individual
 #' @export
-validate_latent_individual <- function(data) {
+epidist_validate.epidist_latent_individual <- function(data) {
   checkmate::assert_true(is_latent_individual(data))
   assert_latent_individual_input(data)
   checkmate::assert_names(
@@ -120,7 +121,7 @@ is_latent_individual <- function(data) {
 #' @export
 epidist_formula.epidist_latent_individual <- function(data, delay_central = ~ 1,
                                                       sigma = ~ 1, ...) {
-  validate_latent_individual(data)
+  epidist_validate(data)
   if (!inherits(delay_central, "formula")) {
     cli::cli_abort("A valid formula for delay_central must be provided")
   }
@@ -152,7 +153,7 @@ epidist_formula.epidist_latent_individual <- function(data, delay_central = ~ 1,
 #' @export
 epidist_family.epidist_latent_individual <- function(data, family = "lognormal",
                                                      ...) {
-  validate_latent_individual(data)
+  epidist_validate(data)
   checkmate::assert_string(family)
 
   pdf_lookup <- rstan::lookup("pdf")
@@ -207,7 +208,7 @@ epidist_family.epidist_latent_individual <- function(data, family = "lognormal",
 #' @family latent_individual
 #' @export
 epidist_prior.epidist_latent_individual <- function(data, ...) {
-  validate_latent_individual(data)
+  epidist_validate(data)
 
   prior1 <- brms::prior("normal(2, 0.5)", class = "Intercept")
   prior2 <- brms::prior("normal(0, 0.5)", class = "Intercept", dpar = "sigma")
@@ -223,7 +224,7 @@ epidist_stancode.epidist_latent_individual <- function(data,
                                                          epidist_family(data),
                                                        ...) {
 
-  validate_latent_individual(data)
+  epidist_validate(data)
 
   stanvars_version <- epidist_version_stanvar()
 

tests/testthat/test-unit-latent_individual.R

@@ -41,17 +41,17 @@ test_that("is_latent_individual returns FALSE for incorrect input", { # nolint:
   })
 })
 
-test_that("validate_latent_individual doesn't produce an error for correct input", { # nolint: line_length_linter.
-  expect_no_error(validate_latent_individual(prep_obs))
+test_that("epidist_validate.epidist_latent_individual doesn't produce an error for correct input", { # nolint: line_length_linter.
+  expect_no_error(epidist_validate(prep_obs))
 })
 
-test_that("validate_latent_individual returns FALSE for incorrect input", { # nolint: line_length_linter.
-  expect_error(validate_latent_individual(list()))
-  expect_error(validate_latent_individual(prep_obs[, 1]))
+test_that("epidist_validate.epidist_latent_individual returns FALSE for incorrect input", { # nolint: line_length_linter.
+  expect_error(epidist_validate(list()))
+  expect_error(epidist_validate(prep_obs[, 1]))
   expect_error({
     x <- list()
     class(x) <- "epidist_latent_individual"
-    validate_latent_individual(x)
+    epidist_validate(x)
   })
 })