Issue 151: data validation as S3 generic (#152)

* Impletement epidist_validate as S3 generic

* Correct documentation

* Fix typo (formula rather than validate)

* Use cli::cli_abort over stop

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)
@@ -25,6 +27,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)
@@ -52,7 +55,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)

R/defaults.R

@@ -1,11 +1,26 @@
+#' Default method for data validation
+#'
+#' @inheritParams epidist_validate
+#' @param ... Additional arguments for method.
+#' @family defaults
+#' @importFrom cli cli_abort
+#' @export
+epidist_validate.default <- function(data, ...) {
+  cli::cli_abort(
+    "No epidist_validate 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
 #' @param ... Additional arguments for method.
 #' @family defaults
+#' @importFrom cli cli_abort
 #' @export
 epidist_formula.default <- function(data, ...) {
-  stop(
+  cli::cli_abort(
     "No epidist_formula method implemented for the class ", class(data), "\n",
     "See methods(epidist_formula) for available methods"
   )
@@ -16,9 +31,10 @@ epidist_formula.default <- function(data, ...) {
 #' @inheritParams epidist_family
 #' @param ... Additional arguments for method.
 #' @family defaults
+#' @importFrom cli cli_abort
 #' @export
 epidist_family.default <- function(data, ...) {
-  stop(
+  cli::cli_abort(
     "No epidist_family method implemented for the class ", class(data), "\n",
     "See methods(epidist_family) for available methods"
   )
@@ -30,9 +46,10 @@ epidist_family.default <- function(data, ...) {
 #' @inheritParams epidist_prior
 #' @param ... Additional arguments for method.
 #' @family defaults
+#' @importFrom cli cli_abort
 #' @export
 epidist_prior.default <- function(data, ...) {
-  stop(
+  cli::cli_abort(
     "No epidist_prior method implemented for the class ", class(data), "\n",
     "See methods(epidist_prior) for available methods"
   )
@@ -43,9 +60,10 @@ epidist_prior.default <- function(data, ...) {
 #' @inheritParams epidist_stancode
 #' @param ... Additional arguments for method.
 #' @family defaults
+#' @importFrom cli cli_abort
 #' @export
 epidist_stancode.default <- function(data, ...) {
-  stop(
+  cli::cli_abort(
     "No epidist_stancode method implemented for the class ", class(data), "\n",
     "See methods(epidist_stancode) for available methods"
   )
@@ -61,6 +79,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,6 +1,15 @@
-#' Define a model specific formula
+#' Validate
 #'
 #' @param data A dataframe to be used for modelling.
+#' @family generics
+#' @export
+epidist_validate <- function(data) {
+  UseMethod("epidist_validate")
+}
+
+#' Define a model specific formula
+#'
+#' @inheritParams epidist_validate
 #' @param ... Additional arguments for method.
 #' @family generics
 #' @export
@@ -10,7 +19,7 @@ epidist_formula <- function(data, ...) {
 
 #' Define model specific family
 #'
-#' @inheritParams epidist_formula
+#' @inheritParams epidist_validate
 #' @param ... Additional arguments for method.
 #' @family generics
 #' @export
@@ -20,7 +29,7 @@ epidist_family <- function(data, ...) {
 
 #' Define model specific priors
 #'
-#' @inheritParams epidist_formula
+#' @inheritParams epidist_validate
 #' @param ... Additional arguments for method.
 #' @rdname epidist_prior
 #' @family generics
@@ -31,7 +40,7 @@ epidist_prior <- function(data, ...) {
 
 #' Define model specific Stan code
 #'
-#' @inheritParams epidist_formula
+#' @inheritParams epidist_validate
 #' @param ... Additional arguments for method.
 #' @rdname epidist_stancode
 #' @family generics
@@ -47,7 +56,7 @@ epidist_stancode <- function(data, ...) {
 #' @param prior ...
 #' @param fn Likely `brms::brm`. Also possible to be `brms::make_stancode` or
 #' `brms::make_standata`.
-#' @inheritParams epidist_formula
+#' @inheritParams epidist_validate
 #' @param ... Additional arguments for method.
 #' @family generics
 #' @export

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