diff --git a/NAMESPACE b/NAMESPACE index 9aa29aab3..20b219bde 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -28,6 +28,7 @@ S3method(print,parameter_tbl) S3method(quantile,epiparameter) S3method(tbl_sum,p_tbl) export(as_epiparameter) +export(assert_epiparameter) export(calc_disc_dist_quantile) export(cdf) export(convert_params_to_summary_stats) @@ -55,7 +56,7 @@ export(is_parameterised) export(is_parameterized) export(is_truncated) export(parameter_tbl) -export(validate_epiparameter) +export(test_epiparameter) importFrom(distributional,cdf) importFrom(distributional,generate) importFrom(lifecycle,deprecated) diff --git a/R/coercion.R b/R/coercion.R index c266d6c2d..eb912c9fc 100644 --- a/R/coercion.R +++ b/R/coercion.R @@ -56,7 +56,7 @@ as.function.epiparameter <- function(x, as.data.frame.epiparameter <- function(x, ...) { chkDots(...) # check object as could be invalidated by user - validate_epiparameter(x) + assert_epiparameter(x) data.frame( disease = x$disease, diff --git a/R/convert_params.R b/R/convert_params.R index 331bfaf3b..5e594a94c 100644 --- a/R/convert_params.R +++ b/R/convert_params.R @@ -90,7 +90,7 @@ convert_summary_stats_to_params.character <- function(x = c("lnorm", "gamma", #' @export convert_summary_stats_to_params.epiparameter <- function(x, ...) { # check input - x <- validate_epiparameter(x) + x <- assert_epiparameter(x) # capture dynamic dots dots <- rlang::dots_list(..., .ignore_empty = "none", .homonyms = "error") @@ -222,7 +222,7 @@ convert_params_to_summary_stats.character <- function(x = c("lnorm", "gamma", #' @export convert_params_to_summary_stats.epiparameter <- function(x, ...) { # check input - x <- validate_epiparameter(x) + x <- assert_epiparameter(x) # capture dynamic dots dots <- rlang::dots_list(..., .ignore_empty = "none", .homonyms = "error") diff --git a/R/epiparameter.R b/R/epiparameter.R index c8239ef0f..66e66451a 100644 --- a/R/epiparameter.R +++ b/R/epiparameter.R @@ -316,54 +316,89 @@ epiparameter <- function(disease, ) # call epiparameter validator - validate_epiparameter(epiparameter = epiparameter) + assert_epiparameter(epiparameter) # return epiparameter object epiparameter } -#' Validator for `` class +#' Assert an object is a valid `` object #' -#' @param epiparameter An `` object +#' @param x An \R object. #' #' @return Invisibly returns an ``. Called for side-effects #' (errors when invalid `` object is provided). #' #' @export -validate_epiparameter <- function(epiparameter) { - if (!is_epiparameter(epiparameter)) { +assert_epiparameter <- function(x) { + if (!is_epiparameter(x)) { stop("Object should be of class epiparameter", call. = FALSE) } + list_names <- c( + "disease", "pathogen", "epi_dist", "prob_dist", "uncertainty", + "summary_stats", "citation", "metadata", "method_assess", "notes" + ) + missing_list_names <- list_names[!list_names %in% attributes(x)$names] + if (length(missing_list_names) != 0) { + stop( + "Object is missing ", toString(missing_list_names), call. = FALSE + ) + } + # check for class invariants stopifnot( - "epiparameter object does not contain the correct attributes" = - c( - "disease", "epi_dist", "prob_dist", "uncertainty", "summary_stats", - "citation", "metadata", "method_assess", "notes" - ) %in% - attributes(epiparameter)$names, "epiparameter must contain a disease (single character string)" = - checkmate::test_string(epiparameter$disease), + checkmate::test_string(x$disease), "epiparameter must contain an epidemiological distribution" = - checkmate::test_string(epiparameter$epi_dist), + checkmate::test_string(x$epi_dist), "epiparameter must contain a or or NA" = checkmate::test_multi_class( - epiparameter$prob_dist, classes = c("distribution", "distcrete") - ) || checkmate::test_string(epiparameter$prob_dist, na.ok = TRUE), + x$prob_dist, classes = c("distribution", "distcrete") + ) || checkmate::test_string(x$prob_dist, na.ok = TRUE), "epidisit must contain uncertainty, summary stats and metadata" = all( - is.list(epiparameter$uncertainty), - is.list(epiparameter$summary_stats), - is.list(epiparameter$metadata) + is.list(x$uncertainty), is.list(x$summary_stats), is.list(x$metadata) ), "epiparameter must contain a citation" = - inherits(epiparameter$citation, "bibentry"), + inherits(x$citation, "bibentry"), "epiparameter notes must be a character string" = - checkmate::test_string(epiparameter$notes) + checkmate::test_string(x$notes) ) - invisible(epiparameter) + invisible(x) +} + +#' Test whether an object is a valid `` object +#' +#' @param x An \R object. +#' +#' @return A boolean `logical` whether the object is a valid `` +#' object. +#' @export +test_epiparameter <- function(x) { # nolint cyclocomp_linter + if (!is_epiparameter(x)) return(FALSE) + + list_names <- c( + "disease", "pathogen", "epi_dist", "prob_dist", "uncertainty", + "summary_stats", "citation", "metadata", "method_assess", "notes" + ) + missing_list_names <- list_names[!list_names %in% attributes(x)$names] + if (length(missing_list_names) != 0) return(FALSE) + + valid_elements <- checkmate::test_string(x$disease) && + checkmate::test_string(x$epi_dist) && + (checkmate::test_multi_class( + x$prob_dist, classes = c("distribution", "distcrete") + ) || checkmate::test_string(x$prob_dist, na.ok = TRUE)) && + all( + is.list(x$uncertainty), is.list(x$summary_stats), is.list(x$metadata) + ) && + inherits(x$citation, "bibentry") && + checkmate::test_string(x$notes) + + if (!valid_elements) return(FALSE) + return(TRUE) } #' Print method for `` class diff --git a/R/epiparameter_db.R b/R/epiparameter_db.R index b022cb406..c75b312a1 100644 --- a/R/epiparameter_db.R +++ b/R/epiparameter_db.R @@ -186,7 +186,7 @@ epiparameter_db <- function(disease = "all", ) } - lapply(multi_epiparameter, validate_epiparameter) + lapply(multi_epiparameter, assert_epiparameter) is_param <- vapply( multi_epiparameter, is_parameterised, @@ -344,7 +344,7 @@ epidist_db <- function(disease = "all", ) } - lapply(multi_epiparameter, validate_epiparameter) + lapply(multi_epiparameter, assert_epiparameter) is_param <- vapply( multi_epiparameter, is_parameterised, diff --git a/R/plot.R b/R/plot.R index ff9a299b8..38836a0f9 100644 --- a/R/plot.R +++ b/R/plot.R @@ -44,7 +44,7 @@ plot.epiparameter <- function(x, cumulative = FALSE, ...) { # check input - validate_epiparameter(x) + assert_epiparameter(x) checkmate::assert_logical(cumulative, any.missing = FALSE, len = 1) # capture dots diff --git a/_pkgdown.yml b/_pkgdown.yml index 72781b274..bd8b56ecf 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -18,7 +18,8 @@ reference: - ends_with("\\.epiparameter") - -has_keyword("epiparameter_distribution_functions") - -starts_with("convert_") - - validate_epiparameter + - assert_epiparameter + - test_epiparameter - ends_with("\\.multi_epiparameter") - title: Accessors diff --git a/inst/WORDLIST b/inst/WORDLIST index 998d0b09b..443423c5c 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -4,6 +4,7 @@ bioRxiv ci CMD Codecov +contactmatrix CoV discretisation discretised diff --git a/man/validate_epiparameter.Rd b/man/assert_epiparameter.Rd similarity index 53% rename from man/validate_epiparameter.Rd rename to man/assert_epiparameter.Rd index e4071cdc4..276e1b8e4 100644 --- a/man/validate_epiparameter.Rd +++ b/man/assert_epiparameter.Rd @@ -1,18 +1,18 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/epiparameter.R -\name{validate_epiparameter} -\alias{validate_epiparameter} -\title{Validator for \verb{} class} +\name{assert_epiparameter} +\alias{assert_epiparameter} +\title{Assert an object is a valid \verb{} object} \usage{ -validate_epiparameter(epiparameter) +assert_epiparameter(x) } \arguments{ -\item{epiparameter}{An \verb{} object} +\item{x}{An \R object.} } \value{ Invisibly returns an \verb{}. Called for side-effects (errors when invalid \verb{} object is provided). } \description{ -Validator for \verb{} class +Assert an object is a valid \verb{} object } diff --git a/man/test_epiparameter.Rd b/man/test_epiparameter.Rd new file mode 100644 index 000000000..205dcf014 --- /dev/null +++ b/man/test_epiparameter.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/epiparameter.R +\name{test_epiparameter} +\alias{test_epiparameter} +\title{Test whether an object is a valid \verb{} object} +\usage{ +test_epiparameter(x) +} +\arguments{ +\item{x}{An \R object.} +} +\value{ +A boolean \code{logical} whether the object is a valid \verb{} +object. +} +\description{ +Test whether an object is a valid \verb{} object +} diff --git a/tests/testthat/test-epiparameter.R b/tests/testthat/test-epiparameter.R index 74d33ef86..00fc50b3f 100644 --- a/tests/testthat/test-epiparameter.R +++ b/tests/testthat/test-epiparameter.R @@ -255,10 +255,10 @@ test_that("new_epiparameter works with minimal viable input", { expect_s3_class(epiparameter_obj, class = "epiparameter") expect_length(epiparameter_obj, 10) - expect_s3_class(validate_epiparameter(epiparameter_obj), class = "epiparameter") + expect_s3_class(assert_epiparameter(epiparameter_obj), class = "epiparameter") }) -test_that("validate_epiparameter passes when expected", { +test_that("assert_epiparameter passes when expected", { epiparameter_obj <- suppressMessages( new_epiparameter( disease = "ebola", @@ -291,10 +291,10 @@ test_that("validate_epiparameter passes when expected", { ) ) - expect_silent(validate_epiparameter(epiparameter = epiparameter_obj)) + expect_silent(assert_epiparameter(epiparameter_obj)) }) -test_that("validate_epiparameter catches class faults when expected", { +test_that("assert_epiparameter catches class faults when expected", { epiparameter_obj <- new_epiparameter( disease = "ebola", pathogen = "ebola_virus", @@ -321,8 +321,8 @@ test_that("validate_epiparameter catches class faults when expected", { epiparameter_obj$disease <- NULL expect_error( - validate_epiparameter(epiparameter = epiparameter_obj), - regexp = "epiparameter object does not contain the correct attributes" + assert_epiparameter(epiparameter_obj), + regexp = "Object is missing disease" ) epiparameter_obj <- new_epiparameter( @@ -351,7 +351,7 @@ test_that("validate_epiparameter catches class faults when expected", { epiparameter_obj$disease <- factor("disease") expect_error( - validate_epiparameter(epiparameter = epiparameter_obj), + assert_epiparameter(epiparameter_obj), regexp = "(epiparameter must contain a disease)" ) @@ -381,18 +381,41 @@ test_that("validate_epiparameter catches class faults when expected", { epiparameter_obj$epi_dist <- c("incubation", "period") expect_error( - validate_epiparameter(epiparameter = epiparameter_obj), + assert_epiparameter(epiparameter_obj), regexp = "epiparameter must contain an epidemiological distribution" ) }) -test_that("validate_epiparameter fails as expected with input class", { +test_that("assert_epiparameter fails as expected with input class", { expect_error( - validate_epiparameter(epiparameter = 1), + assert_epiparameter(1), regexp = "Object should be of class epiparameter" ) }) +test_that("test_epiparameter returns TRUE as expected", { + suppressMessages( + ep <- epiparameter_db(single_epiparameter = TRUE) + ) + expect_true(test_epiparameter(ep)) +}) + +test_that("test_epiparameter returns FALSE as expected", { + expect_false(test_epiparameter(1)) + suppressMessages( + ep <- epiparameter_db(single_epiparameter = TRUE) + ) + ep1 <- ep + ep1$disease <- NULL + expect_false(test_epiparameter(ep1)) + ep2 <- ep + ep2$disease <- 1 + expect_false(test_epiparameter(ep2)) + ep3 <- ep + ep3$citation <- "reference" + expect_false(test_epiparameter(ep3)) +}) + test_that("density works as expected on continuous epiparameter object", { ebola_dist <- suppressMessages( epiparameter( diff --git a/vignettes/design_principles.Rmd b/vignettes/design_principles.Rmd index 88b99c556..9fe6f2d2b 100644 --- a/vignettes/design_principles.Rmd +++ b/vignettes/design_principles.Rmd @@ -20,7 +20,7 @@ This document is primarily intended to be read by those interested in understand ## Scope -The {epiparameter} R package is a library of epidemiological parameters, and provides a class (i.e. data structure) and helper functions for working with epidemiological parameters and distributions. The `` class is the main functional object for working with epidemiological parameters and can hold information on delay distributions (e.g. incubation period, serial interval, onset-to-death distribution) and offspring distributions. The class has a number of methods, including allowing the user to easily calculate the PDF, CDF, and quantile, generate random numbers, calculate the distribution mean, and plot the distribution. An `` object can be created with the constructor function `epiparameter()`, and if uncertain whether an object is an ``, it can be validated with `validate_epiparameter()`. +The {epiparameter} R package is a library of epidemiological parameters, and provides a class (i.e. data structure) and helper functions for working with epidemiological parameters and distributions. The `` class is the main functional object for working with epidemiological parameters and can hold information on delay distributions (e.g. incubation period, serial interval, onset-to-death distribution) and offspring distributions. The class has a number of methods, including allowing the user to easily calculate the PDF, CDF, and quantile, generate random numbers, calculate the distribution mean, and plot the distribution. An `` object can be created with the constructor function `epiparameter()`, and if uncertain whether an object is an ``, it can be validated with `assert_epiparameter()`. The package also converts distribution parameters to summary statistics, and vice versa. This is achieved either by conversion or extraction and both of these methods and the functions used are explained in the [Parameter extraction and conversion in {epiparameter} vignette](extract_convert.html). @@ -32,6 +32,14 @@ Other functions return the simplest type possible, this may be an atomic vector ## Design decisions +* The `` class is designed to be a core unit for working with epidemiological parameters. It is designed in parallel to other epidemiological data structures such as a the `` class from the [{contactmatrix} R package](https://socialcontactdata.github.io/contactmatrix/index.html). The design principles of the `` class are aligned with the [`` design principles](https://socialcontactdata.github.io/contactmatrix/articles/design-principles.html). These include: + - A `new_*()` constructor + - Two validation functions + - `assert_()` + - `test_()` + - An `is_()` checker to determine if an object is of a given class (without checking the validity of class) + - Coercion generic `as_()`. + * The conversion functions (`convert_*`) are S3 generic functions with methods provided by {epiparameter} for `character` and `` input. This follows the design pattern of other packages, such as [{dplyr}](https://dplyr.tidyverse.org/), which export their key data transformation functions as S3 generics to allow other developers to extend the conversions to other data objects. * The conversion functions are designed to have a single function exported to the user for summary statistics to parameters, and another function exported for parameters to summary statistics. These functions use a `switch()` to dispatch to the internal conversion functions. This provides a minimal number of conversion functions in the package namespace compared to exporting a conversion function for every distribution.