Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Replace validate_epiparameter() with assert_epiparameter() #366

Merged
merged 6 commits into from
Aug 13, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down
2 changes: 1 addition & 1 deletion R/coercion.R
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down
4 changes: 2 additions & 2 deletions R/convert_params.R
Original file line number Diff line number Diff line change
Expand Up @@ -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")

Expand Down Expand Up @@ -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")

Expand Down
77 changes: 56 additions & 21 deletions R/epiparameter.R
Original file line number Diff line number Diff line change
Expand Up @@ -316,54 +316,89 @@ epiparameter <- function(disease,
)

# call epiparameter validator
validate_epiparameter(epiparameter = epiparameter)
assert_epiparameter(epiparameter)

# return epiparameter object
epiparameter
}

#' Validator for `<epiparameter>` class
#' Assert an object is a valid `<epiparameter>` object
#'
#' @param epiparameter An `<epiparameter>` object
#' @param x An \R object.
#'
#' @return Invisibly returns an `<epiparameter>`. Called for side-effects
#' (errors when invalid `<epiparameter>` 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 <distribution> or <distcrete> 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 `<epiparameter>` object
#'
#' @param x An \R object.
#'
#' @return A boolean `logical` whether the object is a valid `<epiparameter>`
#' 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 `<epiparameter>` class
Expand Down
4 changes: 2 additions & 2 deletions R/epiparameter_db.R
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down Expand Up @@ -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,
Expand Down
2 changes: 1 addition & 1 deletion R/plot.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
3 changes: 2 additions & 1 deletion _pkgdown.yml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
1 change: 1 addition & 0 deletions inst/WORDLIST
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@ bioRxiv
ci
CMD
Codecov
contactmatrix
CoV
discretisation
discretised
Expand Down
12 changes: 6 additions & 6 deletions man/validate_epiparameter.Rd → man/assert_epiparameter.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

18 changes: 18 additions & 0 deletions man/test_epiparameter.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

43 changes: 33 additions & 10 deletions tests/testthat/test-epiparameter.R
Original file line number Diff line number Diff line change
Expand Up @@ -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",
Expand Down Expand Up @@ -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",
Expand All @@ -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(
Expand Down Expand Up @@ -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)"
)

Expand Down Expand Up @@ -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(
Expand Down
10 changes: 9 additions & 1 deletion vignettes/design_principles.Rmd
Original file line number Diff line number Diff line change
Expand Up @@ -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 `<epiparameter>` 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 `<epiparameter>` object can be created with the constructor function `epiparameter()`, and if uncertain whether an object is an `<epiparameter>`, 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 `<epiparameter>` 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 `<epiparameter>` object can be created with the constructor function `epiparameter()`, and if uncertain whether an object is an `<epiparameter>`, 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).

Expand All @@ -32,6 +32,14 @@ Other functions return the simplest type possible, this may be an atomic vector

## Design decisions

* The `<epiparameter>` 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 `<contactmatrix>` class from the [{contactmatrix} R package](https://socialcontactdata.github.io/contactmatrix/index.html). The design principles of the `<epiparameter>` class are aligned with the [`<contactmatrix>` design principles](https://socialcontactdata.github.io/contactmatrix/articles/design-principles.html). These include:
- A `new_*<class>()` constructor
- Two validation functions
- `assert_<class>()`
- `test_<class>()`
- An `is_<class>()` checker to determine if an object is of a given class (without checking the validity of class)
- Coercion generic `as_<class>()`.

* The conversion functions (`convert_*`) are S3 generic functions with methods provided by {epiparameter} for `character` and `<epiparameter>` 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.
Expand Down
Loading