Skip to content

refactor: use checkmate for arg validation #286

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.

Sign up for GitHub

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

Merged
merged 3 commits into from
Jan 29, 2024
Merged

refactor: use checkmate for arg validation #286

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
6a83de6
refactor: use checkmate for arg validation
dshemetov Jan 26, 2024
cbb1d72
ci: make R CMD check run on dev
dshemetov Jan 29, 2024
f805c3b
doc: bump version
dshemetov Jan 29, 2024
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
4 changes: 2 additions & 2 deletions .github/workflows/R-CMD-check.yaml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,9 +4,9 @@
# Created with usethis + edited to use API key.
on:
push:
branches: [main, master]
branches: [main, dev]
pull_request:
branches: [main, master]
branches: [main, dev]

name: R-CMD-check

Expand Down
3 changes: 2 additions & 1 deletion DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: epipredict
Title: Basic epidemiology forecasting methods
Version: 0.0.8
Version: 0.0.9
Authors@R: c(
person("Daniel", "McDonald", , "[email protected]", role = c("aut", "cre")),
person("Ryan", "Tibshirani", , "[email protected]", role = "aut"),
Expand All @@ -27,6 +27,7 @@ Depends:
parsnip (>= 1.0.0),
R (>= 3.5.0)
Imports:
checkmate,
cli,
distributional,
dplyr,
Expand Down
11 changes: 11 additions & 0 deletions NAMESPACE
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -195,6 +195,17 @@ import(distributional)
import(epiprocess)
import(parsnip)
import(recipes)
importFrom(checkmate,assert)
importFrom(checkmate,assert_character)
importFrom(checkmate,assert_date)
importFrom(checkmate,assert_function)
importFrom(checkmate,assert_int)
importFrom(checkmate,assert_integer)
importFrom(checkmate,assert_integerish)
importFrom(checkmate,assert_logical)
importFrom(checkmate,assert_number)
importFrom(checkmate,assert_numeric)
importFrom(checkmate,assert_scalar)
importFrom(cli,cli_abort)
importFrom(dplyr,across)
importFrom(dplyr,all_of)
Expand Down
3 changes: 2 additions & 1 deletion NEWS.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@ Pre-1.0.0 numbering scheme: 0.x will indicate releases, while 0.0.x will indicat
- add `check_enough_train_data` that will error if training data is too small
- added `check_enough_train_data` to `arx_forecaster`
- simplify `layer_residual_quantiles()` to avoid timesuck in `utils::methods()`
- rename the `dist_quantiles()` to be more descriptive, breaking change)
- rename the `dist_quantiles()` to be more descriptive, breaking change
- removes previous `pivot_quantiles()` (now `*_wider()`, breaking change)
- add `pivot_quantiles_wider()` for easier plotting
- add complement `pivot_quantiles_longer()`
Expand All @@ -31,3 +31,4 @@ Pre-1.0.0 numbering scheme: 0.x will indicate releases, while 0.0.x will indicat
- Publish public for easy navigation
- Two simple forecasters as test beds
- Working vignette
- use `checkmate` for input validation
3 changes: 3 additions & 0 deletions R/epipredict-package.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,9 @@
#' @importFrom stats poly predict lm residuals quantile
#' @importFrom cli cli_abort
#' @importFrom lifecycle deprecated
#' @importFrom checkmate assert assert_character assert_int assert_scalar
#' assert_logical assert_numeric assert_number assert_integer
#' assert_integerish assert_date assert_function
#' @import epiprocess parsnip
## usethis namespace: end
NULL
207 changes: 53 additions & 154 deletions R/utils-arg.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,204 +2,103 @@
# http://adv-r.had.co.nz/Computing-on-the-language.html#substitute
# Modeled after / copied from rundel/ghclass

handle_arg_list <- function(..., tests) {
handle_arg_list <- function(..., .tests) {
values <- list(...)
names <- eval(substitute(alist(...)))
names <- map(names, deparse)

walk2(names, values, tests)
walk2(names, values, .tests)
}

arg_is_scalar <- function(..., allow_null = FALSE, allow_na = FALSE) {
handle_arg_list(
...,
tests = function(name, value) {
if (length(value) > 1 | (!allow_null & length(value) == 0)) {
cli::cli_abort("Argument {.val {name}} must be of length 1.")
}
if (!is.null(value)) {
if (is.na(value) & !allow_na) {
cli::cli_abort(
"Argument {.val {name}} must not be a missing value ({.val {NA}})."
)
}
}
}
)
handle_arg_list(..., .tests = function(name, value) {
assert_scalar(value, null.ok = allow_null, na.ok = allow_na, .var.name = name)
})
}


arg_is_lgl <- function(..., allow_null = FALSE, allow_na = FALSE, allow_empty = FALSE) {
handle_arg_list(
...,
tests = function(name, value) {
if (is.null(value) & !allow_null) {
cli::cli_abort("Argument {.val {name}} must be of logical type.")
}
if (any(is.na(value)) & !allow_na) {
cli::cli_abort("Argument {.val {name}} must not contain any missing values ({.val {NA}}).")
}
if (!is.null(value) & (length(value) == 0 & !allow_empty)) {
cli::cli_abort("Argument {.val {name}} must have length >= 1.")
}
if (!is.null(value) & length(value) != 0 & !is.logical(value)) {
cli::cli_abort("Argument {.val {name}} must be of logical type.")
}
}
)
handle_arg_list(..., .tests = function(name, value) {
assert_logical(value, null.ok = allow_null, any.missing = allow_na, min.len = as.integer(!allow_empty), .var.name = name)
})
}

arg_is_lgl_scalar <- function(..., allow_null = FALSE, allow_na = FALSE) {
arg_is_lgl(..., allow_null = allow_null, allow_na = allow_na)
arg_is_scalar(..., allow_null = allow_null, allow_na = allow_na)
handle_arg_list(..., .tests = function(name, value) {
assert_logical(value, null.ok = allow_null, any.missing = allow_na, min.len = 1, max.len = 1, .var.name = name)
})
}

arg_is_numeric <- function(..., allow_null = FALSE) {
handle_arg_list(
...,
tests = function(name, value) {
if (!(is.numeric(value) | (is.null(value) & allow_null))) {
cli::cli_abort("All {.val {name}} must numeric.")
}
}
)
handle_arg_list(..., .tests = function(name, value) {
assert_numeric(value, null.ok = allow_null, any.missing = FALSE, .var.name = name)
})
}

arg_is_pos <- function(..., allow_null = FALSE) {
arg_is_numeric(..., allow_null = allow_null)
handle_arg_list(
...,
tests = function(name, value) {
if (!(all(value > 0) | (is.null(value) & allow_null))) {
cli::cli_abort("All {.val {name}} must be positive number(s).")
}
}
)
handle_arg_list(..., .tests = function(name, value) {
assert_numeric(value, lower = 1, null.ok = allow_null, any.missing = FALSE, .var.name = name)
})
}

arg_is_nonneg <- function(..., allow_null = FALSE) {
arg_is_numeric(..., allow_null = allow_null)
handle_arg_list(
...,
tests = function(name, value) {
if (!(all(value >= 0) | (is.null(value) & allow_null))) {
cli::cli_abort("All {.val {name}} must be nonnegative number(s).")
}
}
)
handle_arg_list(..., .tests = function(name, value) {
assert_numeric(value, lower = 0, null.ok = allow_null, any.missing = FALSE, .var.name = name)
})
}

arg_is_int <- function(..., allow_null = FALSE) {
arg_is_numeric(..., allow_null = allow_null)
handle_arg_list(
...,
tests = function(name, value) {
if (!(all(value %% 1 == 0) | (is.null(value) & allow_null))) {
cli::cli_abort("All {.val {name}} must be whole positive number(s).")
}
}
)
handle_arg_list(..., .tests = function(name, value) {
assert_integerish(value, null.ok = allow_null, .var.name = name)
})
}

arg_is_pos_int <- function(..., allow_null = FALSE) {
arg_is_int(..., allow_null = allow_null)
arg_is_pos(..., allow_null = allow_null)
handle_arg_list(..., .tests = function(name, value) {
assert_integerish(value, null.ok = allow_null, lower = 1, any.missing = FALSE, .var.name = name)
})
}


arg_is_nonneg_int <- function(..., allow_null = FALSE) {
arg_is_int(..., allow_null = allow_null)
arg_is_nonneg(..., allow_null = allow_null)
}

arg_is_date <- function(..., allow_null = FALSE, allow_na = FALSE) {
handle_arg_list(
...,
tests = function(name, value) {
if (is.null(value) & !allow_null) {
cli::cli_abort("Argument {.val {name}} may not be `NULL`.")
}
if (any(is.na(value)) & !allow_na) {
cli::cli_abort("Argument {.val {name}} must not contain any missing values ({.val {NA}}).")
}
if (!(is(value, "Date") | is.null(value) | all(is.na(value)))) {
cli::cli_abort("Argument {.val {name}} must be a Date. Try `as.Date()`.")
}
}
)
}

arg_is_probabilities <- function(..., allow_null = FALSE) {
arg_is_numeric(..., allow_null = allow_null)
handle_arg_list(
...,
tests = function(name, value) {
if (!((all(value >= 0) && all(value <= 1)) | (is.null(value) & allow_null))) {
cli::cli_abort("All {.val {name}} must be in [0,1].")
}
}
)
handle_arg_list(..., .tests = function(name, value) {
assert_integerish(value, null.ok = allow_null, lower = 0, any.missing = FALSE, .var.name = name)
})
}

arg_is_chr <- function(..., allow_null = FALSE, allow_na = FALSE, allow_empty = FALSE) {
handle_arg_list(
...,
tests = function(name, value) {
if (is.null(value) & !allow_null) {
cli::cli_abort("Argument {.val {name}} may not be `NULL`.")
}
if (any(is.na(value)) & !allow_na) {
cli::cli_abort("Argument {.val {name}} must not contain any missing values ({.val {NA}}).")
}
if (!is.null(value) & (length(value) == 0L & !allow_empty)) {
cli::cli_abort("Argument {.val {name}} must have length > 0.")
}
if (!(is.character(value) | is.null(value) | all(is.na(value)))) {
cli::cli_abort("Argument {.val {name}} must be of character type.")
}
}
)
arg_is_date <- function(..., allow_null = FALSE) {
handle_arg_list(..., .tests = function(name, value) {
assert_date(value, null.ok = allow_null, .var.name = name)
})
}

arg_is_chr_scalar <- function(..., allow_null = FALSE, allow_na = FALSE) {
arg_is_chr(..., allow_null = allow_null, allow_na = allow_na)
arg_is_scalar(..., allow_null = allow_null, allow_na = allow_na)
arg_is_probabilities <- function(..., allow_null = FALSE, allow_na = FALSE) {
handle_arg_list(..., .tests = function(name, value) {
assert_numeric(value, lower = 0, upper = 1, null.ok = allow_null, any.missing = allow_na, .var.name = name)
})
}


arg_is_function <- function(..., allow_null = FALSE) {
handle_arg_list(
...,
tests = function(name, value) {
if (is.null(value) & !allow_null) {
cli::cli_abort("Argument {.val {name}} must be a function.")
}
if (!is.null(value) & !is.function(value)) {
cli::cli_abort("Argument {.val {name}} must be a function.")
}
}
)
arg_is_chr <- function(..., allow_null = FALSE, allow_na = FALSE, allow_empty = FALSE) {
handle_arg_list(..., .tests = function(name, value) {
assert_character(value, null.ok = allow_null, any.missing = allow_na, min.len = as.integer(!allow_empty), .var.name = name)
})
}



arg_is_sorted <- function(..., allow_null = FALSE) {
handle_arg_list(
...,
tests = function(name, value) {
if (is.unsorted(value, na.rm = TRUE) | (is.null(value) & !allow_null)) {
cli::cli_abort("{.val {name}} must be sorted in increasing order.")
}
}
)
arg_is_chr_scalar <- function(..., allow_null = FALSE, allow_na = FALSE) {
handle_arg_list(..., .tests = function(name, value) {
assert_character(value, null.ok = allow_null, any.missing = allow_na, min.len = 1, max.len = 1, .var.name = name)
})
}

arg_is_function <- function(..., allow_null = FALSE) {
handle_arg_list(..., .tests = function(name, value) {
assert_function(value, null.ok = allow_null, .var.name = name)
})
}

arg_to_date <- function(x, allow_null = FALSE, allow_na = FALSE) {
arg_is_scalar(x, allow_null = allow_null, allow_na = allow_na)
arg_to_date <- function(x, allow_null = FALSE) {
arg_is_scalar(x, allow_null = allow_null)
if (!is.null(x)) {
x <- tryCatch(as.Date(x, origin = "1970-01-01"), error = function(e) NA)
}
arg_is_date(x, allow_null = allow_null, allow_na = allow_na)
arg_is_date(x, allow_null = allow_null)
x
}
17 changes: 5 additions & 12 deletions tests/testthat/test-arg_is_.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,7 @@ test_that("scalar", {
test_that("numeric", {
expect_silent(arg_is_numeric(i, j, x, y))
expect_error(arg_is_numeric(a))
expect_error(arg_is_numeric(d))
expect_silent(arg_is_numeric(d))
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Dates now pass arg_is_numeric, this didn't affect the rest of the tests.

expect_silent(arg_is_numeric(c(i, j)))
expect_silent(arg_is_numeric(i, k))
expect_silent(arg_is_numeric(i, j, n, allow_null = TRUE))
Expand All @@ -56,7 +56,7 @@ test_that("numeric", {
test_that("positive", {
expect_silent(arg_is_pos(i, j, x, y))
expect_error(arg_is_pos(a))
expect_error(arg_is_pos(d))
expect_silent(arg_is_pos(d))
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Dates now pass arg_is_positive, this didn't affect the rest of the tests.

expect_silent(arg_is_pos(c(i, j)))
expect_error(arg_is_pos(i, k))
expect_silent(arg_is_pos(i, j, n, allow_null = TRUE))
Expand All @@ -68,7 +68,7 @@ test_that("positive", {
test_that("nonneg", {
expect_silent(arg_is_nonneg(i, j, x, y))
expect_error(arg_is_nonneg(a))
expect_error(arg_is_nonneg(d))
expect_silent(arg_is_nonneg(d))
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Dates now pass arg_is_nonneg, this didn't affect the rest of the tests.

expect_silent(arg_is_nonneg(c(i, j)))
expect_error(arg_is_nonneg(i, k))
expect_silent(arg_is_nonneg(i, j, n, allow_null = TRUE))
Expand Down Expand Up @@ -96,7 +96,8 @@ test_that("date", {
expect_error(arg_is_date(d, dd, n))
expect_error(arg_is_date(d, dd, nn))
expect_silent(arg_is_date(d, dd, n, allow_null = TRUE))
expect_silent(arg_is_date(d, dd, nn, allow_na = TRUE))
# Upstream issue, see: https://github.com/mllg/checkmate/issues/256
# expect_silent(arg_is_date(d, dd, nn, allow_na = TRUE))
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I had to remove allow_na from arg_is_date, due to a checkmate inconsistency, but this didn't affect the rest of the tests.

expect_error(arg_is_date(a))
expect_error(arg_is_date(v))
expect_error(arg_is_date(ll))
Expand Down Expand Up @@ -136,14 +137,6 @@ test_that("function", {
expect_silent(arg_is_function(g, f = NULL, allow_null = TRUE))
})

test_that("sorted", {
expect_silent(arg_is_sorted(a = 1:5, b = 6:10))
expect_error(arg_is_sorted(a = 5:1, b = 6:10))
expect_error(arg_is_sorted(b = NULL))
expect_silent(arg_is_sorted(b = NULL, allow_null = TRUE))
})


Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

These weren't used anywhere and checkmate supports a sorted check for some data types, so I figured we could rely on that when we need it.

test_that("coerce scalar to date", {
expect_error(arg_to_date("12345"))
expect_s3_class(arg_to_date(12345), "Date")
Expand Down