From 42ff019495cf3e5dbd2015436f6ec0d4e5098932 Mon Sep 17 00:00:00 2001 From: athowes Date: Fri, 12 Jul 2024 11:00:52 +0100 Subject: [PATCH] Impletement epidist_validate as S3 generic --- NAMESPACE | 5 +++- R/defaults.R | 14 +++++++++++ R/generics.R | 8 +++++++ R/latent_individual.R | 13 ++++++----- man/as_latent_individual.Rd | 8 +++---- man/epidist.Rd | 3 ++- man/epidist.default.Rd | 3 ++- man/epidist_family.Rd | 3 ++- man/epidist_family.default.Rd | 3 ++- man/epidist_formula.Rd | 3 ++- man/epidist_formula.default.Rd | 3 ++- ...idist_formula.epidist_latent_individual.Rd | 4 ++-- man/epidist_prior.Rd | 3 ++- man/epidist_prior.default.Rd | 3 ++- ...epidist_prior.epidist_latent_individual.Rd | 4 ++-- man/epidist_stancode.Rd | 3 ++- man/epidist_stancode.default.Rd | 3 ++- man/epidist_validate.Rd | 20 ++++++++++++++++ man/epidist_validate.default.Rd | 23 +++++++++++++++++++ ...ist_validate.epidist_latent_individual.Rd} | 6 ++--- man/is_latent_individual.Rd | 2 +- tests/testthat/test-unit-latent_individual.R | 12 +++++----- 22 files changed, 114 insertions(+), 35 deletions(-) create mode 100644 man/epidist_validate.Rd create mode 100644 man/epidist_validate.default.Rd rename man/{validate_latent_individual.Rd => epidist_validate.epidist_latent_individual.Rd} (83%) diff --git a/NAMESPACE b/NAMESPACE index c04f42354..3407288a0 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/defaults.R b/R/defaults.R index a62523018..301c238ba 100644 --- a/R/defaults.R +++ b/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, diff --git a/R/generics.R b/R/generics.R index 877bb799e..f34da81ee 100644 --- a/R/generics.R +++ b/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. diff --git a/R/latent_individual.R b/R/latent_individual.R index 936c99d93..de66d3131 100644 --- a/R/latent_individual.R +++ b/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() diff --git a/man/as_latent_individual.Rd b/man/as_latent_individual.Rd index cc500e9e6..bf4a4ce2b 100644 --- a/man/as_latent_individual.Rd +++ b/man/as_latent_individual.Rd @@ -26,13 +26,13 @@ model. Other latent_individual: \code{\link{epidist_formula.epidist_latent_individual}()}, \code{\link{epidist_prior.epidist_latent_individual}()}, -\code{\link{is_latent_individual}()}, -\code{\link{validate_latent_individual}()} +\code{\link{epidist_validate.epidist_latent_individual}()}, +\code{\link{is_latent_individual}()} Other latent_individual: \code{\link{epidist_formula.epidist_latent_individual}()}, \code{\link{epidist_prior.epidist_latent_individual}()}, -\code{\link{is_latent_individual}()}, -\code{\link{validate_latent_individual}()} +\code{\link{epidist_validate.epidist_latent_individual}()}, +\code{\link{is_latent_individual}()} } \concept{latent_individual} diff --git a/man/epidist.Rd b/man/epidist.Rd index 3c4d9c8ea..34b5e93e2 100644 --- a/man/epidist.Rd +++ b/man/epidist.Rd @@ -28,6 +28,7 @@ Other generics: \code{\link{epidist_family}()}, \code{\link{epidist_formula}()}, \code{\link{epidist_prior}()}, -\code{\link{epidist_stancode}()} +\code{\link{epidist_stancode}()}, +\code{\link{epidist_validate}()} } \concept{generics} diff --git a/man/epidist.default.Rd b/man/epidist.default.Rd index cce05188d..6e36b35cf 100644 --- a/man/epidist.default.Rd +++ b/man/epidist.default.Rd @@ -35,6 +35,7 @@ Other defaults: \code{\link{epidist_family.default}()}, \code{\link{epidist_formula.default}()}, \code{\link{epidist_prior.default}()}, -\code{\link{epidist_stancode.default}()} +\code{\link{epidist_stancode.default}()}, +\code{\link{epidist_validate.default}()} } \concept{defaults} diff --git a/man/epidist_family.Rd b/man/epidist_family.Rd index f15d17f28..0983f90f9 100644 --- a/man/epidist_family.Rd +++ b/man/epidist_family.Rd @@ -19,6 +19,7 @@ Other generics: \code{\link{epidist}()}, \code{\link{epidist_formula}()}, \code{\link{epidist_prior}()}, -\code{\link{epidist_stancode}()} +\code{\link{epidist_stancode}()}, +\code{\link{epidist_validate}()} } \concept{generics} diff --git a/man/epidist_family.default.Rd b/man/epidist_family.default.Rd index 791cdf6fd..8897f988f 100644 --- a/man/epidist_family.default.Rd +++ b/man/epidist_family.default.Rd @@ -19,6 +19,7 @@ Other defaults: \code{\link{epidist.default}()}, \code{\link{epidist_formula.default}()}, \code{\link{epidist_prior.default}()}, -\code{\link{epidist_stancode.default}()} +\code{\link{epidist_stancode.default}()}, +\code{\link{epidist_validate.default}()} } \concept{defaults} diff --git a/man/epidist_formula.Rd b/man/epidist_formula.Rd index e900f5116..d252b375c 100644 --- a/man/epidist_formula.Rd +++ b/man/epidist_formula.Rd @@ -19,6 +19,7 @@ Other generics: \code{\link{epidist}()}, \code{\link{epidist_family}()}, \code{\link{epidist_prior}()}, -\code{\link{epidist_stancode}()} +\code{\link{epidist_stancode}()}, +\code{\link{epidist_validate}()} } \concept{generics} diff --git a/man/epidist_formula.default.Rd b/man/epidist_formula.default.Rd index ad5d57af1..caf83e06d 100644 --- a/man/epidist_formula.default.Rd +++ b/man/epidist_formula.default.Rd @@ -19,6 +19,7 @@ Other defaults: \code{\link{epidist.default}()}, \code{\link{epidist_family.default}()}, \code{\link{epidist_prior.default}()}, -\code{\link{epidist_stancode.default}()} +\code{\link{epidist_stancode.default}()}, +\code{\link{epidist_validate.default}()} } \concept{defaults} diff --git a/man/epidist_formula.epidist_latent_individual.Rd b/man/epidist_formula.epidist_latent_individual.Rd index 0af4c4ded..c212896b3 100644 --- a/man/epidist_formula.epidist_latent_individual.Rd +++ b/man/epidist_formula.epidist_latent_individual.Rd @@ -23,7 +23,7 @@ Define a formula for the latent_individual model Other latent_individual: \code{\link{as_latent_individual}()}, \code{\link{epidist_prior.epidist_latent_individual}()}, -\code{\link{is_latent_individual}()}, -\code{\link{validate_latent_individual}()} +\code{\link{epidist_validate.epidist_latent_individual}()}, +\code{\link{is_latent_individual}()} } \concept{latent_individual} diff --git a/man/epidist_prior.Rd b/man/epidist_prior.Rd index 1dd39211a..fdbdf2c0e 100644 --- a/man/epidist_prior.Rd +++ b/man/epidist_prior.Rd @@ -19,6 +19,7 @@ Other generics: \code{\link{epidist}()}, \code{\link{epidist_family}()}, \code{\link{epidist_formula}()}, -\code{\link{epidist_stancode}()} +\code{\link{epidist_stancode}()}, +\code{\link{epidist_validate}()} } \concept{generics} diff --git a/man/epidist_prior.default.Rd b/man/epidist_prior.default.Rd index 6f2c500c1..5888e0664 100644 --- a/man/epidist_prior.default.Rd +++ b/man/epidist_prior.default.Rd @@ -19,6 +19,7 @@ Other defaults: \code{\link{epidist.default}()}, \code{\link{epidist_family.default}()}, \code{\link{epidist_formula.default}()}, -\code{\link{epidist_stancode.default}()} +\code{\link{epidist_stancode.default}()}, +\code{\link{epidist_validate.default}()} } \concept{defaults} diff --git a/man/epidist_prior.epidist_latent_individual.Rd b/man/epidist_prior.epidist_latent_individual.Rd index 9f3e5ba03..a7376d097 100644 --- a/man/epidist_prior.epidist_latent_individual.Rd +++ b/man/epidist_prior.epidist_latent_individual.Rd @@ -42,7 +42,7 @@ a future date. Other latent_individual: \code{\link{as_latent_individual}()}, \code{\link{epidist_formula.epidist_latent_individual}()}, -\code{\link{is_latent_individual}()}, -\code{\link{validate_latent_individual}()} +\code{\link{epidist_validate.epidist_latent_individual}()}, +\code{\link{is_latent_individual}()} } \concept{latent_individual} diff --git a/man/epidist_stancode.Rd b/man/epidist_stancode.Rd index 8b8afe9da..f68908a74 100644 --- a/man/epidist_stancode.Rd +++ b/man/epidist_stancode.Rd @@ -19,6 +19,7 @@ Other generics: \code{\link{epidist}()}, \code{\link{epidist_family}()}, \code{\link{epidist_formula}()}, -\code{\link{epidist_prior}()} +\code{\link{epidist_prior}()}, +\code{\link{epidist_validate}()} } \concept{generics} diff --git a/man/epidist_stancode.default.Rd b/man/epidist_stancode.default.Rd index 0e448975f..fd2cf2ae0 100644 --- a/man/epidist_stancode.default.Rd +++ b/man/epidist_stancode.default.Rd @@ -19,6 +19,7 @@ Other defaults: \code{\link{epidist.default}()}, \code{\link{epidist_family.default}()}, \code{\link{epidist_formula.default}()}, -\code{\link{epidist_prior.default}()} +\code{\link{epidist_prior.default}()}, +\code{\link{epidist_validate.default}()} } \concept{defaults} diff --git a/man/epidist_validate.Rd b/man/epidist_validate.Rd new file mode 100644 index 000000000..01b5ece85 --- /dev/null +++ b/man/epidist_validate.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/generics.R +\name{epidist_validate} +\alias{epidist_validate} +\title{Validate} +\usage{ +epidist_validate(data) +} +\description{ +Validate +} +\seealso{ +Other generics: +\code{\link{epidist}()}, +\code{\link{epidist_family}()}, +\code{\link{epidist_formula}()}, +\code{\link{epidist_prior}()}, +\code{\link{epidist_stancode}()} +} +\concept{generics} diff --git a/man/epidist_validate.default.Rd b/man/epidist_validate.default.Rd new file mode 100644 index 000000000..f0e08f88b --- /dev/null +++ b/man/epidist_validate.default.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/defaults.R +\name{epidist_validate.default} +\alias{epidist_validate.default} +\title{Default method for data validation} +\usage{ +\method{epidist_validate}{default}(data, ...) +} +\arguments{ +\item{...}{Additional arguments for method.} +} +\description{ +Default method for data validation +} +\seealso{ +Other defaults: +\code{\link{epidist.default}()}, +\code{\link{epidist_family.default}()}, +\code{\link{epidist_formula.default}()}, +\code{\link{epidist_prior.default}()}, +\code{\link{epidist_stancode.default}()} +} +\concept{defaults} diff --git a/man/validate_latent_individual.Rd b/man/epidist_validate.epidist_latent_individual.Rd similarity index 83% rename from man/validate_latent_individual.Rd rename to man/epidist_validate.epidist_latent_individual.Rd index 75adf1732..cb17c2748 100644 --- a/man/validate_latent_individual.Rd +++ b/man/epidist_validate.epidist_latent_individual.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/latent_individual.R -\name{validate_latent_individual} -\alias{validate_latent_individual} +\name{epidist_validate.epidist_latent_individual} +\alias{epidist_validate.epidist_latent_individual} \title{Validate latent individual model data} \usage{ -validate_latent_individual(data) +\method{epidist_validate}{epidist_latent_individual}(data) } \arguments{ \item{data}{A \code{data.frame} or \code{data.table} containing line list data} diff --git a/man/is_latent_individual.Rd b/man/is_latent_individual.Rd index d0ae1724f..7f6eba288 100644 --- a/man/is_latent_individual.Rd +++ b/man/is_latent_individual.Rd @@ -17,6 +17,6 @@ Other latent_individual: \code{\link{as_latent_individual}()}, \code{\link{epidist_formula.epidist_latent_individual}()}, \code{\link{epidist_prior.epidist_latent_individual}()}, -\code{\link{validate_latent_individual}()} +\code{\link{epidist_validate.epidist_latent_individual}()} } \concept{latent_individual} diff --git a/tests/testthat/test-unit-latent_individual.R b/tests/testthat/test-unit-latent_individual.R index 24f45cde7..33e21965e 100644 --- a/tests/testthat/test-unit-latent_individual.R +++ b/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) }) })