From 4433dce45a43df36cf0c74bb5500f72509548bac Mon Sep 17 00:00:00 2001 From: Hannah Frick Date: Fri, 19 Jul 2024 16:44:02 +0100 Subject: [PATCH 1/5] cover all error messages in tests --- tests/testthat/_snaps/initial.md | 12 ++++++++++-- tests/testthat/test-initial.R | 25 ++++++++++++++----------- 2 files changed, 24 insertions(+), 13 deletions(-) diff --git a/tests/testthat/_snaps/initial.md b/tests/testthat/_snaps/initial.md index bc9c6444..69344098 100644 --- a/tests/testthat/_snaps/initial.md +++ b/tests/testthat/_snaps/initial.md @@ -1,4 +1,12 @@ -# default time param with lag +# `initial_time_split()` error messages + + Code + initial_time_split(drinks, prop = 2) + Condition + Error in `initial_time_split()`: + ! `prop` must be a number on (0, 1). + +--- Code initial_time_split(drinks, lag = 12.5) @@ -9,7 +17,7 @@ --- Code - initial_time_split(drinks, lag = 500) + initial_time_split(drinks, lag = nrow(drinks) + 1) Condition Error in `initial_time_split()`: ! `lag` must be less than or equal to the number of training observations. diff --git a/tests/testthat/test-initial.R b/tests/testthat/test-initial.R index bf7ccf96..775b8a47 100644 --- a/tests/testthat/test-initial.R +++ b/tests/testthat/test-initial.R @@ -27,20 +27,23 @@ test_that("default time param with lag", { expect_equal(nrow(ts1), ceiling(nrow(dat1) / 4) + 5) expect_equal(tr1, dplyr::slice(dat1, 1:floor(nrow(dat1) * 3 / 4))) expect_equal(ts1, dat1[(floor(nrow(dat1) * 3 / 4) + 1 - 5):nrow(dat1), ], ignore_attr = "row.names") +}) +test_that("`initial_time_split()` error messages", { skip_if_not_installed("modeldata") - data(drinks, package = "modeldata") + data(drinks, package = "modeldata", envir = rlang::current_env()) - # Whole numbers only - expect_snapshot( - initial_time_split(drinks, lag = 12.5), - error = TRUE - ) - # Lag must be less than number of training observations - expect_snapshot( - initial_time_split(drinks, lag = 500), - error = TRUE - ) + expect_snapshot(error = TRUE, { + initial_time_split(drinks, prop = 2) + }) + + expect_snapshot(error = TRUE, { + initial_time_split(drinks, lag = 12.5) + }) + + expect_snapshot(error = TRUE, { + initial_time_split(drinks, lag = nrow(drinks) + 1) + }) }) test_that("default group param", { From 904cc4d0de06882b753fe9b848e11c65a912a17b Mon Sep 17 00:00:00 2001 From: Hannah Frick Date: Fri, 19 Jul 2024 16:51:39 +0100 Subject: [PATCH 2/5] import `cli_abort()` --- NAMESPACE | 1 + R/rsample-package.R | 1 + 2 files changed, 2 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index ca35d5c6..f1154bcd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -415,6 +415,7 @@ export(validation_split) export(validation_time_split) export(vfold_cv) import(vctrs) +importFrom(cli,cli_abort) importFrom(dplyr,"%>%") importFrom(dplyr,arrange) importFrom(dplyr,arrange_) diff --git a/R/rsample-package.R b/R/rsample-package.R index 56be5b76..ab2e172c 100644 --- a/R/rsample-package.R +++ b/R/rsample-package.R @@ -3,6 +3,7 @@ ## usethis namespace: start #' @importFrom lifecycle deprecated +#' @importFrom cli cli_abort ## usethis namespace: end NULL From 02a76eabf0901e3ff958fea659614e7ab230eb14 Mon Sep 17 00:00:00 2001 From: Hannah Frick Date: Fri, 19 Jul 2024 17:05:05 +0100 Subject: [PATCH 3/5] snapshots did not change in this case --- R/initial_split.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/initial_split.R b/R/initial_split.R index 2951b6f2..66157c76 100644 --- a/R/initial_split.R +++ b/R/initial_split.R @@ -73,17 +73,17 @@ initial_split <- function(data, prop = 3 / 4, initial_time_split <- function(data, prop = 3 / 4, lag = 0, ...) { check_dots_empty() if (!is.numeric(prop) | prop >= 1 | prop <= 0) { - rlang::abort("`prop` must be a number on (0, 1).") + cli_abort("{.arg prop} must be a number on (0, 1).") } if (!is.numeric(lag) | !(lag %% 1 == 0)) { - rlang::abort("`lag` must be a whole number.") + cli_abort("{.arg lag} must be a whole number.") } n_train <- floor(nrow(data) * prop) if (lag > n_train) { - rlang::abort("`lag` must be less than or equal to the number of training observations.") + cli_abort("{.arg lag} must be less than or equal to the number of training observations.") } split <- rsplit(data, 1:n_train, (n_train + 1 - lag):nrow(data)) From 4825cf7f46143bc0d759084cd0744ecf4cc8ac2b Mon Sep 17 00:00:00 2001 From: Hannah Frick Date: Fri, 19 Jul 2024 17:31:19 +0100 Subject: [PATCH 4/5] snapshot errors from `complement()` --- tests/testthat/_snaps/rsplit.md | 10 +++++++++- tests/testthat/test-rsplit.R | 12 +++++++----- 2 files changed, 16 insertions(+), 6 deletions(-) diff --git a/tests/testthat/_snaps/rsplit.md b/tests/testthat/_snaps/rsplit.md index f98d0c04..9a63d215 100644 --- a/tests/testthat/_snaps/rsplit.md +++ b/tests/testthat/_snaps/rsplit.md @@ -28,7 +28,7 @@ 1 validation -# default complement method errors +# `complement()` error messages Code complement("a string") @@ -36,3 +36,11 @@ Error in `complement()`: ! No `complement()` method for this class(es) 'character' +--- + + Code + get_stored_out_id(list(out_id = NA)) + Condition + Error in `get_stored_out_id()`: + ! Cannot derive the assessment set for this type of resampling. + diff --git a/tests/testthat/test-rsplit.R b/tests/testthat/test-rsplit.R index 1b5216df..9475d806 100644 --- a/tests/testthat/test-rsplit.R +++ b/tests/testthat/test-rsplit.R @@ -52,11 +52,13 @@ test_that("print methods", { }) }) -test_that("default complement method errors", { - expect_snapshot( - complement("a string"), - error = TRUE - ) +test_that("`complement()` error messages", { + expect_snapshot(error = TRUE, { + complement("a string") + }) + expect_snapshot(error = TRUE, { + get_stored_out_id(list(out_id = NA)) + }) }) test_that("as.data.frame() works for permutations with Surv object without the survival package loaded - issue #443", { From e4d445bcaff8a126124ecad8e806e5d17782bcb9 Mon Sep 17 00:00:00 2001 From: Hannah Frick Date: Fri, 19 Jul 2024 17:46:10 +0100 Subject: [PATCH 5/5] transition errors for `complement()` --- R/complement.R | 6 +++--- tests/testthat/_snaps/rsplit.md | 12 ++++++++++-- tests/testthat/test-rsplit.R | 8 +++++++- 3 files changed, 20 insertions(+), 6 deletions(-) diff --git a/R/complement.R b/R/complement.R index babddaeb..a3f1cf31 100644 --- a/R/complement.R +++ b/R/complement.R @@ -85,9 +85,9 @@ complement.apparent_split <- function(x, ...) { #' @export complement.default <- function(x, ...) { - cls <- paste0("'", class(x), "'", collapse = ", ") - rlang::abort( - paste("No `complement()` method for this class(es)", cls) + x_cls <- class(x) + cli_abort( + "No {.fn complement} method for objects of class{?es}: {.cls {x_cls}}" ) } diff --git a/tests/testthat/_snaps/rsplit.md b/tests/testthat/_snaps/rsplit.md index 9a63d215..5b785db6 100644 --- a/tests/testthat/_snaps/rsplit.md +++ b/tests/testthat/_snaps/rsplit.md @@ -31,10 +31,18 @@ # `complement()` error messages Code - complement("a string") + complement(fake_rsplit) Condition Error in `complement()`: - ! No `complement()` method for this class(es) 'character' + ! No `complement()` method for objects of class: + +--- + + Code + complement(fake_rsplit) + Condition + Error in `complement()`: + ! No `complement()` method for objects of classes: --- diff --git a/tests/testthat/test-rsplit.R b/tests/testthat/test-rsplit.R index 9475d806..4d452ea2 100644 --- a/tests/testthat/test-rsplit.R +++ b/tests/testthat/test-rsplit.R @@ -53,8 +53,14 @@ test_that("print methods", { }) test_that("`complement()` error messages", { + fake_rsplit <- 1 + class(fake_rsplit) <- c("not_an_rsplit") expect_snapshot(error = TRUE, { - complement("a string") + complement(fake_rsplit) + }) + class(fake_rsplit) <- c("not_an_rsplit", "really_not_an_rsplit") + expect_snapshot(error = TRUE, { + complement(fake_rsplit) }) expect_snapshot(error = TRUE, { get_stored_out_id(list(out_id = NA))