diff --git a/tests/testthat/_snaps/boot.md b/tests/testthat/_snaps/boot.md index aa8a7972..442c72ca 100644 --- a/tests/testthat/_snaps/boot.md +++ b/tests/testthat/_snaps/boot.md @@ -14,6 +14,23 @@ # bad args + Code + bootstraps(warpbreaks, strata = warpbreaks$tension) + Condition + Error in `bootstraps()`: + ! Can't select columns that don't exist. + x Columns `L`, `L`, `L`, `L`, `L`, etc. don't exist. + +--- + + Code + bootstraps(warpbreaks, strata = c("tension", "wool")) + Condition + Error in `strata_check()`: + ! `strata` should be a single name or character value. + +--- + Code group_bootstraps(warpbreaks, tension) Condition diff --git a/tests/testthat/_snaps/bootci.md b/tests/testthat/_snaps/bootci.md index 46ae8df5..26fa9aad 100644 --- a/tests/testthat/_snaps/bootci.md +++ b/tests/testthat/_snaps/bootci.md @@ -28,3 +28,194 @@ Error in `bca_calc()`: ! All statistics have missing values. +# Sufficient replications needed to sufficiently reduce Monte Carlo sampling Error for BCa method + + Code + int_pctl(bt_small, stats) + Condition + Warning: + Recommend at least 1000 non-missing bootstrap resamples for term `mean`. + Output + # A tibble: 1 x 6 + term .lower .estimate .upper .alpha .method + + 1 mean 9.97 10.0 10.1 0.05 percentile + +--- + + Code + int_t(bt_small, stats) + Condition + Warning: + Recommend at least 500 non-missing bootstrap resamples for term `mean`. + Output + # A tibble: 1 x 6 + term .lower .estimate .upper .alpha .method + + 1 mean 9.96 10.0 10.1 0.05 student-t + +--- + + Code + int_bca(bt_small, stats, .fn = get_stats) + Condition + Warning: + Recommend at least 1000 non-missing bootstrap resamples for term `mean`. + Output + # A tibble: 1 x 6 + term .lower .estimate .upper .alpha .method + + 1 mean 9.96 10.0 10.1 0.05 BCa + +# bad input + + Code + int_pctl(bt_small, id) + Condition + Error in `check_tidy()`: + ! {.arg statistics} should select a list column of tidy results. + +--- + + Code + int_pctl(bt_small, junk) + Condition + Error in `check_tidy()`: + ! {.arg statistics} should select a list column of tidy results. + +--- + + Code + int_pctl(bt_small, stats, alpha = c(0.05, 0.2)) + Condition + Error in `int_pctl()`: + ! `alpha` must be a single numeric value. + +--- + + Code + int_t(bt_small, stats, alpha = "potato") + Condition + Error in `int_t()`: + ! `alpha` must be a single numeric value. + +--- + + Code + int_bca(bt_small, stats, alpha = 1:2, .fn = get_stats) + Condition + Error in `int_bca()`: + ! `alpha` must be a single numeric value. + +--- + + Code + int_pctl(vfold_cv(mtcars)) + Condition + Error in `UseMethod()`: + ! no applicable method for 'int_pctl' applied to an object of class "c('vfold_cv', 'rset', 'tbl_df', 'tbl', 'data.frame')" + +--- + + Code + int_t(vfold_cv(mtcars)) + Condition + Error in `UseMethod()`: + ! no applicable method for 'int_t' applied to an object of class "c('vfold_cv', 'rset', 'tbl_df', 'tbl', 'data.frame')" + +--- + + Code + int_bca(vfold_cv(mtcars)) + Condition + Error in `UseMethod()`: + ! no applicable method for 'int_bca' applied to an object of class "c('vfold_cv', 'rset', 'tbl_df', 'tbl', 'data.frame')" + +--- + + Code + int_t(bad_bt_norm, stats) + Condition + Error in `check_tidy_names()`: + ! `statistics` should select a single column for the standard error. + +--- + + Code + int_bca(bt_norm, stats, .fn = no_dots) + Condition + Error in `has_dots()`: + ! `.fn` must have an argument `...`. + +--- + + Code + int_pctl(as.data.frame(bt_norm), stats) + Condition + Error in `UseMethod()`: + ! no applicable method for 'int_pctl' applied to an object of class "data.frame" + +--- + + Code + int_t(as.data.frame(bt_norm), stats) + Condition + Error in `UseMethod()`: + ! no applicable method for 'int_t' applied to an object of class "data.frame" + +--- + + Code + int_bca(as.data.frame(bt_norm), stats, .fn = get_stats) + Condition + Error in `UseMethod()`: + ! no applicable method for 'int_bca' applied to an object of class "data.frame" + +--- + + Code + int_t(bt_norm %>% dplyr::filter(id != "Apparent"), stats) + Condition + Error in `UseMethod()`: + ! no applicable method for 'int_t' applied to an object of class "c('tbl_df', 'tbl', 'data.frame')" + +--- + + Code + int_bca(bt_norm %>% dplyr::filter(id != "Apparent"), stats, .fn = get_stats) + Condition + Error in `UseMethod()`: + ! no applicable method for 'int_bca' applied to an object of class "c('tbl_df', 'tbl', 'data.frame')" + +--- + + Code + int_pctl(badder_bt_norm, bad_term) + Condition + Error in `check_tidy_names()`: + ! The tibble in `statistics` should have columns for 'estimate' and 'term'. + +--- + + Code + int_t(badder_bt_norm, bad_err) + Condition + Error in `check_tidy_names()`: + ! `statistics` should select a single column for the standard error. + +--- + + Code + int_bca(badder_bt_norm, bad_est, .fn = get_stats) + Condition + Error in `check_tidy_names()`: + ! The tibble in `statistics` should have columns for 'estimate' and 'term'. + +--- + + Code + int_pctl(badder_bt_norm, bad_num) + Condition + Error in `pctl_single()`: + ! `stats` must be a numeric vector. + diff --git a/tests/testthat/_snaps/clustering.md b/tests/testthat/_snaps/clustering.md index fa157507..048a87c1 100644 --- a/tests/testthat/_snaps/clustering.md +++ b/tests/testthat/_snaps/clustering.md @@ -1,18 +1,34 @@ # bad args - `vars` is required and must contain at least one variable in `data`. + Code + clustering_cv(dat1) + Condition + Error in `clustering_cv()`: + ! `vars` is required and must contain at least one variable in `data`. --- - `v` must be a single positive integer greater than 1. + Code + clustering_cv(iris, Sepal.Length, v = -500) + Condition + Error in `clustering_cv()`: + ! `v` must be a single positive integer greater than 1. --- - The number of rows is less than `v` = 500. + Code + clustering_cv(iris, Sepal.Length, v = 500) + Condition + Error in `clustering_cv()`: + ! The number of rows is less than `v` = 500. --- - `cluster_function` must be one of "kmeans" or "hclust", not "not an option". + Code + clustering_cv(iris, Sepal.Length, cluster_function = "not an option") + Condition + Error in `clustering_cv()`: + ! `cluster_function` must be one of "kmeans" or "hclust", not "not an option". --- @@ -24,11 +40,19 @@ --- - `repeats` must be a single positive integer. + Code + clustering_cv(Orange, repeats = 0) + Condition + Error in `clustering_cv()`: + ! `repeats` must be a single positive integer. --- - `repeats` must be a single positive integer. + Code + clustering_cv(Orange, repeats = NULL) + Condition + Error in `clustering_cv()`: + ! `repeats` must be a single positive integer. --- diff --git a/tests/testthat/_snaps/form_pred.md b/tests/testthat/_snaps/form_pred.md new file mode 100644 index 00000000..9249675e --- /dev/null +++ b/tests/testthat/_snaps/form_pred.md @@ -0,0 +1,32 @@ +# dots + + Code + form_pred(y ~ .) + Condition + Error in `terms.formula()`: + ! '.' in formula and no 'data' argument + +--- + + Code + form_pred(terms(y ~ .)) + Condition + Error in `terms.formula()`: + ! '.' in formula and no 'data' argument + +--- + + Code + form_pred(y ~ (.)^2) + Condition + Error in `terms.formula()`: + ! '.' in formula and no 'data' argument + +--- + + Code + form_pred(terms(y ~ (.)^2)) + Condition + Error in `terms.formula()`: + ! '.' in formula and no 'data' argument + diff --git a/tests/testthat/_snaps/labels.md b/tests/testthat/_snaps/labels.md index ff278c5d..31467814 100644 --- a/tests/testthat/_snaps/labels.md +++ b/tests/testthat/_snaps/labels.md @@ -6,3 +6,37 @@ Error in `labels()`: ! `labels` not implemented for nested resampling +# adding labels + + Code + analysis(car_folds$splits[[1]]) %>% add_resample_id(car_folds$splits[[1]], 7) + Condition + Error in `add_resample_id()`: + ! `dots` should be a single logical. + +--- + + Code + analysis(car_folds$splits[[1]]) %>% add_resample_id(car_folds$splits[[1]], c( + TRUE, TRUE)) + Condition + Error in `add_resample_id()`: + ! `dots` should be a single logical. + +--- + + Code + analysis(car_folds$splits[[1]]) %>% add_resample_id(car_folds$splits) + Condition + Error in `add_resample_id()`: + ! `split` should be a single object. + +--- + + Code + analysis(car_folds$splits[[1]]) %>% as.matrix() %>% add_resample_id(car_folds$ + splits[[1]]) + Condition + Error in `add_resample_id()`: + ! `.data` should be a data frame. + diff --git a/tests/testthat/_snaps/make_strata.md b/tests/testthat/_snaps/make_strata.md index bbda3d21..35a70cfb 100644 --- a/tests/testthat/_snaps/make_strata.md +++ b/tests/testthat/_snaps/make_strata.md @@ -1,5 +1,41 @@ +# simple numerics + + Code + str1b <- make_strata(x1, depth = 500) + Condition + Warning: + The number of observations in each quantile is below the recommended threshold of 500. + * Stratification will use 2 breaks instead. + +# simple character + + Code + str2a <- make_strata(x2, pool = 0.05) + Condition + Warning: + Stratifying groups that make up 5% of the data may be statistically risky. + * Consider increasing `pool` to at least 0.1 + +--- + + Code + str2b <- make_strata(x2, pool = 0.05) + Condition + Warning: + Stratifying groups that make up 5% of the data may be statistically risky. + * Consider increasing `pool` to at least 0.1 + # bad data + Code + s0 <- make_strata(x3) + Condition + Warning: + Too little data to stratify. + * Resampling will be unstratified. + +--- + Code s1 <- make_strata(x3, pool = 0.06) Condition @@ -28,3 +64,11 @@ The bins specified by `breaks` must be >=2. * Resampling will be unstratified. +# don't stratify on Surv objects + + Code + strata_check("surv", df) + Condition + Error in `strata_check()`: + ! `strata` cannot be a object. Use the time or event variable directly. + diff --git a/tests/testthat/_snaps/mc.md b/tests/testthat/_snaps/mc.md index 17708974..22446560 100644 --- a/tests/testthat/_snaps/mc.md +++ b/tests/testthat/_snaps/mc.md @@ -1,3 +1,20 @@ +# bad args + + Code + mc_cv(warpbreaks, strata = warpbreaks$tension) + Condition + Error in `mc_cv()`: + ! Can't select columns that don't exist. + x Columns `L`, `L`, `L`, `L`, `L`, etc. don't exist. + +--- + + Code + mc_cv(warpbreaks, strata = c("tension", "wool")) + Condition + Error in `strata_check()`: + ! `strata` should be a single name or character value. + # printing Code @@ -21,6 +38,50 @@ # grouping - bad args + Code + group_mc_cv(warpbreaks, group = warpbreaks$tension) + Condition + Error in `validate_group()`: + ! Can't select columns that don't exist. + x Columns `L`, `L`, `L`, `L`, `L`, etc. don't exist. + +--- + + Code + group_mc_cv(warpbreaks, group = c("tension", "wool")) + Condition + Error in `group_mc_cv()`: + ! `group` should be a single character value for the column that will be used for splitting. + +--- + + Code + group_mc_cv(warpbreaks, group = "tensio") + Condition + Error in `validate_group()`: + ! Can't select columns that don't exist. + x Column `tensio` doesn't exist. + +--- + + Code + group_mc_cv(warpbreaks) + Condition + Error in `group_mc_cv()`: + ! `group` should be a single character value for the column that will be used for splitting. + +--- + + Code + group_mc_cv(warpbreaks, group = "tension", balance = "groups") + Condition + Error in `group_mc_cv()`: + ! `...` must be empty. + x Problematic argument: + * balance = "groups" + +--- + Code group_mc_cv(warpbreaks, group = "tension", prop = 0.99) Condition diff --git a/tests/testthat/_snaps/misc.md b/tests/testthat/_snaps/misc.md index 040b2669..1e2b60e7 100644 --- a/tests/testthat/_snaps/misc.md +++ b/tests/testthat/_snaps/misc.md @@ -1,3 +1,27 @@ +# cannot create a split with an empty analysis set + + Code + make_splits(indices, df) + Condition + Error in `rsplit()`: + ! At least one row should be selected for the analysis set. + +# cannot create a split from empty training dataframe + + Code + make_splits(training, testing) + Condition + Error in `make_splits()`: + ! The analysis set must contain at least one row. + +# cannot create a split from dataframes with different columns + + Code + make_splits(training, testing) + Condition + Error in `make_splits()`: + ! The analysis and assessment sets must have the same columns. + # improper argument Code diff --git a/tests/testthat/_snaps/permutations.md b/tests/testthat/_snaps/permutations.md index 84233a4f..7651a025 100644 --- a/tests/testthat/_snaps/permutations.md +++ b/tests/testthat/_snaps/permutations.md @@ -8,6 +8,33 @@ # bad args + Code + permutations(mtcars) + Condition + Error in `permutations()`: + ! You must specify at least one column to permute. + +--- + + Code + permutations(mtcars, foo) + Condition + Error in `permutations()`: + ! Can't select columns that don't exist. + x Column `foo` doesn't exist. + +--- + + Code + permutations(mtcars, start_with("z")) + Condition + Error in `permutations()`: + i In argument: `start_with("z")`. + Caused by error in `start_with()`: + ! could not find function "start_with" + +--- + Code permutations(mtcars, everything()) Condition diff --git a/tests/testthat/_snaps/reg_intervals.md b/tests/testthat/_snaps/reg_intervals.md index 95850f88..d27eba80 100644 --- a/tests/testthat/_snaps/reg_intervals.md +++ b/tests/testthat/_snaps/reg_intervals.md @@ -12,3 +12,27 @@ > 1 wt -5.62 -3.46 -0.955 0.05 student-t [1,001 x 2] +--- + + Code + reg_intervals(mpg ~ disp + wt, data = mtcars, model_fn = "potato") + Condition + Error in `reg_intervals()`: + ! `model_fn` must be one of "lm", "glm", "survreg", or "coxph", not "potato". + +--- + + Code + reg_intervals(mpg ~ disp + wt, data = mtcars, type = "random") + Condition + Error in `reg_intervals()`: + ! `type` must be one of "student-t" or "percentile", not "random". + +--- + + Code + reg_intervals(mpg ~ disp + wt, data = mtcars, alpha = "a") + Condition + Error in `reg_intervals()`: + ! `alpha` must be a single numeric value. + diff --git a/tests/testthat/_snaps/reshuffle_rset.md b/tests/testthat/_snaps/reshuffle_rset.md index 5d416219..53373e8c 100644 --- a/tests/testthat/_snaps/reshuffle_rset.md +++ b/tests/testthat/_snaps/reshuffle_rset.md @@ -119,14 +119,26 @@ --- - Cannot reshuffle this rset (`attr(rset, 'strata')` is "TRUE", not a column identifier) - i If the original object was created with an older version of rsample, try recreating it with the newest version of the package. + Code + reshuffle_rset(resample) + Condition + Error in `reshuffle_rset()`: + ! Cannot reshuffle this rset (`attr(rset, 'strata')` is "TRUE", not a column identifier) + i If the original object was created with an older version of rsample, try recreating it with the newest version of the package. --- - `manual_rset` objects cannot be reshuffled. + Code + reshuffle_rset(rset_subclasses[["manual_rset"]]) + Condition + Error in `reshuffle_rset()`: + ! `manual_rset` objects cannot be reshuffled. --- - `rset` must be an object. + Code + reshuffle_rset(rset_subclasses[["manual_rset"]]$splits[[1]]) + Condition + Error in `reshuffle_rset()`: + ! `rset` must be an object. diff --git a/tests/testthat/_snaps/rolling_origin.md b/tests/testthat/_snaps/rolling_origin.md new file mode 100644 index 00000000..57b851ba --- /dev/null +++ b/tests/testthat/_snaps/rolling_origin.md @@ -0,0 +1,16 @@ +# lag + + Code + rolling_origin(drinks, initial = 5, lag = 6) + Condition + Error in `rolling_origin()`: + ! `lag` must be less than or equal to the number of training observations. + +--- + + Code + rolling_origin(drinks, lag = 2.1) + Condition + Error in `rolling_origin()`: + ! `lag` must be a whole number. + diff --git a/tests/testthat/_snaps/rset.md b/tests/testthat/_snaps/rset.md index 60dc8c41..b172bfe5 100644 --- a/tests/testthat/_snaps/rset.md +++ b/tests/testthat/_snaps/rset.md @@ -1,8 +1,56 @@ # bad args + Code + new_rset(car_folds$splits[1:2], car_folds$id) + Condition + Error in `new_rset()`: + ! Split and ID vectors have different lengths. + +--- + + Code + new_rset(car_folds$splits, car_folds["splits"]) + Condition + Error in `new_rset()`: + ! The `id` tibble column names should start with 'id'. + +--- + + Code + new_rset(car_folds$splits, car_folds$splits) + Condition + Error in `new_rset()`: + ! All ID columns should be character or factor vectors. + +--- + Code new_rset(list(1), "x") Condition Error in `new_rset()`: ! Each element of `splits` must be an object. +--- + + Code + new_rset(car_folds$splits, car_folds$id, attrib = args) + Condition + Error in `new_rset()`: + ! `attrib` should be a fully named list. + +# not an rsplit + + Code + analysis(folds$splits[1]) + Condition + Error in `analysis()`: + ! No method for objects of class: list + +--- + + Code + assessment(folds$splits[1]) + Condition + Error in `assessment()`: + ! No method for objects of class: list + diff --git a/tests/testthat/_snaps/rsplit.md b/tests/testthat/_snaps/rsplit.md index c5db834d..b4b730b4 100644 --- a/tests/testthat/_snaps/rsplit.md +++ b/tests/testthat/_snaps/rsplit.md @@ -1,3 +1,51 @@ +# bad inputs + + Code + rsplit(as.list(dat1), 1:2, 4:5) + Condition + Error in `rsplit()`: + ! `data` must be a data frame. + +--- + + Code + rsplit(dat1, letters[1:2], 4:5) + Condition + Error in `rsplit()`: + ! `in_id` must be a positive integer vector. + +--- + + Code + rsplit(as.list(dat1), 1:2, letters[4:5]) + Condition + Error in `rsplit()`: + ! `data` must be a data frame. + +--- + + Code + rsplit(as.list(dat1), -1:2, 4:5) + Condition + Error in `rsplit()`: + ! `data` must be a data frame. + +--- + + Code + rsplit(as.list(dat1), 1:2, -4:5) + Condition + Error in `rsplit()`: + ! `data` must be a data frame. + +--- + + Code + rsplit(as.list(dat1), integer(0), 4:5) + Condition + Error in `rsplit()`: + ! `data` must be a data frame. + # print methods Code diff --git a/tests/testthat/_snaps/slide.md b/tests/testthat/_snaps/slide.md new file mode 100644 index 00000000..12a81bad --- /dev/null +++ b/tests/testthat/_snaps/slide.md @@ -0,0 +1,146 @@ +# `data` is validated + + Code + sliding_window(1) + Condition + Error in `sliding_window()`: + ! `data` must be a data frame. + +--- + + Code + sliding_index(1) + Condition + Error in `sliding_index()`: + ! `data` must be a data frame. + +--- + + Code + sliding_period(1) + Condition + Error in `sliding_period()`: + ! `data` must be a data frame. + +# `lookback` is validated + + Code + sliding_window(data.frame(), lookback = -1) + Condition + Error in `check_lookback()`: + ! `lookback` must be positive, or zero. + +--- + + Code + sliding_window(data.frame(), lookback = "a") + Condition + Error in `check_lookback()`: + ! `lookback` must be an integer of size 1, or `Inf`. + +--- + + Code + sliding_window(data.frame(), lookback = c(1, 2)) + Condition + Error in `check_lookback()`: + ! `lookback` must have size 1. + +--- + + Code + sliding_window(data.frame(), lookback = NA) + Condition + Error in `check_lookback()`: + ! `lookback` must be an integer of size 1, or `Inf`. + +# `assess_start` is validated + + Code + sliding_window(data.frame(), assess_start = -1) + Condition + Error in `check_assess()`: + ! `assess_start` must be positive. + +--- + + Code + sliding_window(data.frame(), assess_start = "a") + Condition + Error in `check_assess()`: + ! `assess_start` must be an integer of size 1, or `Inf`. + +--- + + Code + sliding_window(data.frame(), assess_start = c(1, 2)) + Condition + Error in `check_assess()`: + ! `assess_start` must have size 1. + +--- + + Code + sliding_window(data.frame(), assess_start = NA) + Condition + Error in `check_assess()`: + ! `assess_start` must be an integer of size 1, or `Inf`. + +# `assess_stop` is validated + + Code + sliding_window(data.frame(), assess_stop = -1) + Condition + Error in `check_assess()`: + ! `assess_stop` must be positive. + +--- + + Code + sliding_window(data.frame(), assess_stop = "a") + Condition + Error in `check_assess()`: + ! `assess_stop` must be an integer of size 1, or `Inf`. + +--- + + Code + sliding_window(data.frame(), assess_stop = c(1, 2)) + Condition + Error in `check_assess()`: + ! `assess_stop` must have size 1. + +--- + + Code + sliding_window(data.frame(), assess_stop = NA) + Condition + Error in `check_assess()`: + ! `assess_stop` must be an integer of size 1, or `Inf`. + +# `assess_start` must be before or equal to `assess_stop` + + Code + sliding_window(data.frame(), assess_start = 2, assess_stop = 1) + Condition + Error in `sliding_window()`: + ! `assess_start` must be less than or equal to `assess_stop`. + +# `index` is validated + + Code + sliding_index(df, y) + Condition + Error in `sliding_index()`: + ! Can't select columns that don't exist. + x Column `y` doesn't exist. + +--- + + Code + sliding_period(df, y) + Condition + Error in `sliding_period()`: + ! Can't select columns that don't exist. + x Column `y` doesn't exist. + diff --git a/tests/testthat/_snaps/validation_split.md b/tests/testthat/_snaps/validation_split.md index 482dfc2c..a9215489 100644 --- a/tests/testthat/_snaps/validation_split.md +++ b/tests/testthat/_snaps/validation_split.md @@ -77,6 +77,23 @@ 1 37074 12926 50000 3 validation +# bad args + + Code + validation_split(warpbreaks, strata = warpbreaks$tension) + Condition + Error in `validation_split()`: + ! Can't select columns that don't exist. + x Columns `L`, `L`, `L`, `L`, `L`, etc. don't exist. + +--- + + Code + validation_split(warpbreaks, strata = c("tension", "wool")) + Condition + Error in `strata_check()`: + ! `strata` should be a single name or character value. + # printing Code diff --git a/tests/testthat/_snaps/vfold.md b/tests/testthat/_snaps/vfold.md index be1ad488..d590cc6b 100644 --- a/tests/testthat/_snaps/vfold.md +++ b/tests/testthat/_snaps/vfold.md @@ -9,31 +9,76 @@ # bad args - `v` must be a single positive integer greater than 1. + Code + vfold_cv(iris, strata = iris$Species) + Condition + Error in `vfold_cv()`: + ! Can't select columns that don't exist. + x Columns `setosa`, `setosa`, `setosa`, `setosa`, `setosa`, etc. don't exist. + +--- + + Code + vfold_cv(iris, strata = c("Species", "Sepal.Width")) + Condition + Error in `strata_check()`: + ! `strata` should be a single name or character value. --- - `v` must be a single positive integer greater than 1. + Code + vfold_cv(iris, v = -500) + Condition + Error in `vfold_cv()`: + ! `v` must be a single positive integer greater than 1. + +--- + + Code + vfold_cv(iris, v = 1) + Condition + Error in `vfold_cv()`: + ! `v` must be a single positive integer greater than 1. --- - `v` must be a single positive integer greater than 1. + Code + vfold_cv(iris, v = NULL) + Condition + Error in `vfold_cv()`: + ! `v` must be a single positive integer greater than 1. --- - The number of rows is less than `v` = 500. + Code + vfold_cv(iris, v = 500) + Condition + Error in `vfold_cv()`: + ! The number of rows is less than `v` = 500. --- - Repeated resampling when `v` is 150 would create identical resamples. + Code + vfold_cv(iris, v = 150, repeats = 2) + Condition + Error in `vfold_cv()`: + ! Repeated resampling when `v` is 150 would create identical resamples. --- - `repeats` must be a single positive integer. + Code + vfold_cv(Orange, repeats = 0) + Condition + Error in `vfold_cv()`: + ! `repeats` must be a single positive integer. --- - `repeats` must be a single positive integer. + Code + vfold_cv(Orange, repeats = NULL) + Condition + Error in `vfold_cv()`: + ! `repeats` must be a single positive integer. --- @@ -67,11 +112,61 @@ # grouping -- bad args - Repeated resampling when `v` is 4 would create identical resamples. + Code + group_vfold_cv(warpbreaks, group = warpbreaks$tension) + Condition + Error in `validate_group()`: + ! Can't select columns that don't exist. + x Columns `L`, `L`, `L`, `L`, `L`, etc. don't exist. --- - Repeated resampling when `v` is "NULL" would create identical resamples. + Code + group_vfold_cv(warpbreaks, group = c("tension", "wool")) + Condition + Error in `group_vfold_cv()`: + ! `group` should be a single character value for the column that will be used for splitting. + +--- + + Code + group_vfold_cv(warpbreaks, group = "tensio") + Condition + Error in `validate_group()`: + ! Can't select columns that don't exist. + x Column `tensio` doesn't exist. + +--- + + Code + group_vfold_cv(warpbreaks) + Condition + Error in `group_vfold_cv()`: + ! `group` should be a single character value for the column that will be used for splitting. + +--- + + Code + group_vfold_cv(warpbreaks, group = "tension", v = 10) + Condition + Error in `group_vfold_cv()`: + ! The number of groups is less than `v` = 10. + +--- + + Code + group_vfold_cv(dat1, c, v = 4, repeats = 4) + Condition + Error in `group_vfold_cv()`: + ! Repeated resampling when `v` is 4 would create identical resamples. + +--- + + Code + group_vfold_cv(dat1, c, repeats = 4) + Condition + Error in `group_vfold_cv()`: + ! Repeated resampling when `v` is "NULL" would create identical resamples. --- @@ -112,8 +207,28 @@ --- - Leaving `v = NULL` while using stratification will set `v` to the number of groups present in the least common stratum. - i Set `v` explicitly to override this warning. + Code + group_vfold_cv(sample_data, group, strata = outcome) + Condition + Warning in `group_vfold_cv()`: + Leaving `v = NULL` while using stratification will set `v` to the number of groups present in the least common stratum. + i Set `v` explicitly to override this warning. + Output + # Group 30-fold cross-validation + # A tibble: 30 x 2 + splits id + + 1 Resample01 + 2 Resample02 + 3 Resample03 + 4 Resample04 + 5 Resample05 + 6 Resample06 + 7 Resample07 + 8 Resample08 + 9 Resample09 + 10 Resample10 + # i 20 more rows --- @@ -131,8 +246,28 @@ --- - Leaving `v = NULL` while using stratification will set `v` to the number of groups present in the least common stratum. - i Set `v` explicitly to override this warning. + Code + group_vfold_cv(sample_data, group, strata = outcome) + Condition + Warning in `group_vfold_cv()`: + Leaving `v = NULL` while using stratification will set `v` to the number of groups present in the least common stratum. + i Set `v` explicitly to override this warning. + Output + # Group 30-fold cross-validation + # A tibble: 30 x 2 + splits id + + 1 Resample01 + 2 Resample02 + 3 Resample03 + 4 Resample04 + 5 Resample05 + 6 Resample06 + 7 Resample07 + 8 Resample08 + 9 Resample09 + 10 Resample10 + # i 20 more rows # grouping -- printing diff --git a/tests/testthat/test-boot.R b/tests/testthat/test-boot.R index 83db0fe8..84e19792 100644 --- a/tests/testthat/test-boot.R +++ b/tests/testthat/test-boot.R @@ -146,8 +146,12 @@ test_that("grouping -- strata", { test_that("bad args", { - expect_error(bootstraps(warpbreaks, strata = warpbreaks$tension)) - expect_error(bootstraps(warpbreaks, strata = c("tension", "wool"))) + expect_snapshot(error = TRUE, { + bootstraps(warpbreaks, strata = warpbreaks$tension) + }) + expect_snapshot(error = TRUE, { + bootstraps(warpbreaks, strata = c("tension", "wool")) + }) set.seed(1) expect_snapshot( group_bootstraps(warpbreaks, tension) diff --git a/tests/testthat/test-bootci.R b/tests/testthat/test-bootci.R index 119a4c8e..d0ea5296 100644 --- a/tests/testthat/test-bootci.R +++ b/tests/testthat/test-bootci.R @@ -153,40 +153,79 @@ test_that("Upper & lower confidence interval does not contain NA", { # ------------------------------------------------------------------------------ -set.seed(456765) -bt_small <- - bootstraps(dat, times = 10, apparent = TRUE) %>% - dplyr::mutate( - stats = purrr::map(splits, ~ get_stats(.x)), - junk = 1:11 - ) - test_that( "Sufficient replications needed to sufficiently reduce Monte Carlo sampling Error for BCa method", { - expect_warning(int_pctl(bt_small, stats)) - expect_warning(int_t(bt_small, stats)) - expect_warning(int_bca(bt_small, stats, .fn = get_stats)) + set.seed(456765) + bt_small <- + bootstraps(dat, times = 10, apparent = TRUE) %>% + dplyr::mutate( + stats = purrr::map(splits, ~ get_stats(.x)), + junk = 1:11 + ) + + expect_snapshot(int_pctl(bt_small, stats)) + expect_snapshot(int_t(bt_small, stats)) } ) +test_that( + "Sufficient replications needed to sufficiently reduce Monte Carlo sampling Error for BCa method", + { + skip("until we don't get a message about loading purrr in the snapshot in R CMD check hard") + # unskip this by moving the expectation back into the test_that block above + set.seed(456765) + bt_small <- + bootstraps(dat, times = 10, apparent = TRUE) %>% + dplyr::mutate( + stats = purrr::map(splits, ~ get_stats(.x)), + junk = 1:11 + ) + + expect_snapshot(int_bca(bt_small, stats, .fn = get_stats)) + } +) test_that("bad input", { - expect_error(int_pctl(bt_small, id)) - expect_error(int_pctl(bt_small, junk)) - expect_error(int_pctl(bt_small, stats, alpha = c(0.05, 0.2))) - expect_error(int_t(bt_small, stats, alpha = "potato")) - expect_error(int_bca(bt_small, stats, alpha = 1:2, .fn = get_stats)) - expect_error(int_pctl(vfold_cv(mtcars))) - expect_error(int_t(vfold_cv(mtcars))) - expect_error(int_bca(vfold_cv(mtcars))) + set.seed(456765) + bt_small <- + bootstraps(dat, times = 10, apparent = TRUE) %>% + dplyr::mutate( + stats = purrr::map(splits, ~ get_stats(.x)), + junk = 1:11 + ) + + expect_snapshot(error = TRUE, { + int_pctl(bt_small, id) + }) + expect_snapshot(error = TRUE, { + int_pctl(bt_small, junk) + }) + expect_snapshot(error = TRUE, { + int_pctl(bt_small, stats, alpha = c(0.05, 0.2)) + }) + expect_snapshot(error = TRUE, { + int_t(bt_small, stats, alpha = "potato") + }) + expect_snapshot(error = TRUE, { + int_bca(bt_small, stats, alpha = 1:2, .fn = get_stats) + }) + expect_snapshot(error = TRUE, { + int_pctl(vfold_cv(mtcars)) + }) + expect_snapshot(error = TRUE, { + int_t(vfold_cv(mtcars)) + }) + expect_snapshot(error = TRUE, { + int_bca(vfold_cv(mtcars)) + }) bad_bt_norm <- bt_norm %>% mutate(stats = purrr::map(stats, ~ .x[, 1:2])) - expect_error(int_t(bad_bt_norm, stats)) - - expect_error(int_bca(bad_bt_norm, stats)) + expect_snapshot(error = TRUE, { + int_t(bad_bt_norm, stats) + }) no_dots <- function(split) { dat <- analysis(split) @@ -197,21 +236,26 @@ test_that("bad input", { std.error = sqrt(var(x, na.rm = TRUE) / sum(!is.na(x))) ) } - expect_error( - int_bca(bt_norm, stats, .fn = no_dots), - "must have an argument" - ) - - expect_error(int_pctl(as.data.frame(bt_norm), stats)) - expect_error(int_t(as.data.frame(bt_norm), stats)) - expect_error(int_bca(as.data.frame(bt_norm), stats, .fn = get_stats)) - - expect_error( + expect_snapshot(error = TRUE, { + int_bca(bt_norm, stats, .fn = no_dots) + }) + + expect_snapshot(error = TRUE, { + int_pctl(as.data.frame(bt_norm), stats) + }) + expect_snapshot(error = TRUE, { + int_t(as.data.frame(bt_norm), stats) + }) + expect_snapshot(error = TRUE, { + int_bca(as.data.frame(bt_norm), stats, .fn = get_stats) + }) + + expect_snapshot(error = TRUE, { int_t(bt_norm %>% dplyr::filter(id != "Apparent"), stats) - ) - expect_error( + }) + expect_snapshot(error = TRUE, { int_bca(bt_norm %>% dplyr::filter(id != "Apparent"), stats, .fn = get_stats) - ) + }) poo <- function(x) { x$estimate <- "a" @@ -225,10 +269,18 @@ test_that("bad input", { bad_err = purrr::map(stats, ~ .x %>% setNames(c("term", "estimate", "c"))), bad_num = purrr::map(stats, ~ poo(.x)) ) - expect_error(int_pctl(badder_bt_norm, bad_term)) - expect_error(int_t(badder_bt_norm, bad_err)) - expect_error(int_bca(badder_bt_norm, bad_est, .fn = get_stats)) - expect_error(int_pctl(badder_bt_norm, bad_num)) + expect_snapshot(error = TRUE, { + int_pctl(badder_bt_norm, bad_term) + }) + expect_snapshot(error = TRUE, { + int_t(badder_bt_norm, bad_err) + }) + expect_snapshot(error = TRUE, { + int_bca(badder_bt_norm, bad_est, .fn = get_stats) + }) + expect_snapshot(error = TRUE, { + int_pctl(badder_bt_norm, bad_num) + }) }) diff --git a/tests/testthat/test-clustering.R b/tests/testthat/test-clustering.R index f049bd00..d8037b84 100644 --- a/tests/testthat/test-clustering.R +++ b/tests/testthat/test-clustering.R @@ -38,14 +38,30 @@ test_that("repeated", { }) test_that("bad args", { - expect_snapshot_error(clustering_cv(dat1)) - expect_snapshot_error(clustering_cv(iris, Sepal.Length, v = -500)) - expect_snapshot_error(clustering_cv(iris, Sepal.Length, v = 500)) - expect_snapshot_error(clustering_cv(iris, Sepal.Length, cluster_function = "not an option")) - expect_snapshot(error = TRUE, clustering_cv(Orange, v = 1, vars = "Tree")) - expect_snapshot_error(clustering_cv(Orange, repeats = 0)) - expect_snapshot_error(clustering_cv(Orange, repeats = NULL)) - expect_snapshot(error = TRUE, clustering_cv(mtcars, mpg, v = nrow(mtcars))) + expect_snapshot(error = TRUE, { + clustering_cv(dat1) + }) + expect_snapshot(error = TRUE, { + clustering_cv(iris, Sepal.Length, v = -500) + }) + expect_snapshot(error = TRUE, { + clustering_cv(iris, Sepal.Length, v = 500) + }) + expect_snapshot(error = TRUE, { + clustering_cv(iris, Sepal.Length, cluster_function = "not an option") + }) + expect_snapshot(error = TRUE, { + clustering_cv(Orange, v = 1, vars = "Tree") + }) + expect_snapshot(error = TRUE, { + clustering_cv(Orange, repeats = 0) + }) + expect_snapshot(error = TRUE, { + clustering_cv(Orange, repeats = NULL) + }) + expect_snapshot(error = TRUE, { + clustering_cv(mtcars, mpg, v = nrow(mtcars)) + }) }) test_that("printing", { diff --git a/tests/testthat/test-form_pred.R b/tests/testthat/test-form_pred.R index 2eb08617..b5bc56c0 100644 --- a/tests/testthat/test-form_pred.R +++ b/tests/testthat/test-form_pred.R @@ -25,11 +25,19 @@ test_that("no dots", { }) test_that("dots", { - expect_error(form_pred(y ~ .)) - expect_error(form_pred(terms(y ~ .))) - - expect_error(form_pred(y ~ (.)^2)) - expect_error(form_pred(terms(y ~ (.)^2))) + expect_snapshot(error = TRUE, { + form_pred(y ~ .) + }) + expect_snapshot(error = TRUE, { + form_pred(terms(y ~ .)) + }) + + expect_snapshot(error = TRUE, { + form_pred(y ~ (.)^2) + }) + expect_snapshot(error = TRUE, { + form_pred(terms(y ~ (.)^2)) + }) expect_equal( form_pred(terms(mpg ~ (.)^2, data = mtcars)), diff --git a/tests/testthat/test-labels.R b/tests/testthat/test-labels.R index 975785ed..0483c6c2 100644 --- a/tests/testthat/test-labels.R +++ b/tests/testthat/test-labels.R @@ -48,23 +48,23 @@ test_that("adding labels", { expect_equal(colnames(res), c(colnames(mtcars), ".id")) - expect_error( + expect_snapshot(error = TRUE, { analysis(car_folds$splits[[1]]) %>% add_resample_id(car_folds$splits[[1]], 7) - ) - expect_error( + }) + expect_snapshot(error = TRUE, { analysis(car_folds$splits[[1]]) %>% add_resample_id(car_folds$splits[[1]], c(TRUE, TRUE)) - ) + }) - expect_error( + expect_snapshot(error = TRUE, { analysis(car_folds$splits[[1]]) %>% add_resample_id(car_folds$splits) - ) + }) - expect_error( + expect_snapshot(error = TRUE, { analysis(car_folds$splits[[1]]) %>% as.matrix() %>% add_resample_id(car_folds$splits[[1]]) - ) + }) }) diff --git a/tests/testthat/test-make_strata.R b/tests/testthat/test-make_strata.R index 97845b4a..3704783b 100644 --- a/tests/testthat/test-make_strata.R +++ b/tests/testthat/test-make_strata.R @@ -5,7 +5,7 @@ test_that("simple numerics", { tab1a <- table(str1a) expect_equal(as.vector(tab1a), rep(250, 4)) - expect_warning(str1b <- make_strata(x1, depth = 500), "2 breaks instead") + expect_snapshot(str1b <- make_strata(x1, depth = 500)) tab1b <- table(str1b) expect_equal(as.vector(tab1b), rep(500, 2)) @@ -16,24 +16,22 @@ test_that("simple numerics", { test_that("simple character", { x2 <- factor(rep(LETTERS[1:12], each = 20)) - expect_warning( - str2a <- make_strata(x2, pool = 0.05), - "Stratifying groups that make up 5%" - ) + expect_snapshot({ + str2a <- make_strata(x2, pool = 0.05) + }) expect_equal(table(str2a, dnn = ""), table(x2, dnn = "")) x2[5] <- NA - expect_warning( - str2b <- make_strata(x2, pool = 0.05), - "Stratifying groups that make up 5%" - ) + expect_snapshot({ + str2b <- make_strata(x2, pool = 0.05) + }) expect_true(all(as.vector(table(str2b, dnn = "")) %in% 19:21)) }) test_that("bad data", { x3 <- factor(rep(LETTERS[1:15], each = 50)) - expect_warning(make_strata(x3), "Too little data") + expect_snapshot(s0 <- make_strata(x3)) expect_snapshot(s1 <- make_strata(x3, pool = 0.06)) expect_snapshot(s2 <- make_strata(mtcars$mpg)) expect_snapshot(s3 <- make_strata(seq_len(50), breaks = -1)) @@ -59,5 +57,7 @@ test_that("don't stratify on Surv objects", { class = "Surv" ) - expect_error(strata_check("surv", df)) + expect_snapshot(error = TRUE, { + strata_check("surv", df) + }) }) diff --git a/tests/testthat/test-mc.R b/tests/testthat/test-mc.R index cd1bc5d8..742fd13f 100644 --- a/tests/testthat/test-mc.R +++ b/tests/testthat/test-mc.R @@ -72,8 +72,12 @@ test_that("strata", { test_that("bad args", { - expect_error(mc_cv(warpbreaks, strata = warpbreaks$tension)) - expect_error(mc_cv(warpbreaks, strata = c("tension", "wool"))) + expect_snapshot(error = TRUE, { + mc_cv(warpbreaks, strata = warpbreaks$tension) + }) + expect_snapshot(error = TRUE, { + mc_cv(warpbreaks, strata = c("tension", "wool")) + }) }) @@ -91,16 +95,25 @@ test_that("rsplit labels", { }) test_that("grouping - bad args", { - expect_error(group_mc_cv(warpbreaks, group = warpbreaks$tension)) - expect_error(group_mc_cv(warpbreaks, group = c("tension", "wool"))) - expect_error(group_mc_cv(warpbreaks, group = "tensio")) - expect_error(group_mc_cv(warpbreaks)) - expect_error(group_mc_cv(warpbreaks, group = "tension", balance = "groups")) + expect_snapshot(error = TRUE, { + group_mc_cv(warpbreaks, group = warpbreaks$tension) + }) + expect_snapshot(error = TRUE, { + group_mc_cv(warpbreaks, group = c("tension", "wool")) + }) + expect_snapshot(error = TRUE, { + group_mc_cv(warpbreaks, group = "tensio") + }) + expect_snapshot(error = TRUE, { + group_mc_cv(warpbreaks) + }) + expect_snapshot(error = TRUE, { + group_mc_cv(warpbreaks, group = "tension", balance = "groups") + }) set.seed(1) - expect_snapshot( - group_mc_cv(warpbreaks, group = "tension", prop = 0.99), - error = TRUE - ) + expect_snapshot(error = TRUE, { + group_mc_cv(warpbreaks, group = "tension", prop = 0.99) + }) }) test_that("grouping - default param", { diff --git a/tests/testthat/test-misc.R b/tests/testthat/test-misc.R index 6fdcda55..a45454ce 100644 --- a/tests/testthat/test-misc.R +++ b/tests/testthat/test-misc.R @@ -12,7 +12,9 @@ test_that("cannot create a split with an empty analysis set", { df <- data.frame(x = c(1, 2, 3, 4)) indices <- list(analysis = integer(), assessment = 1:4) - expect_error(make_splits(indices, df), "At least one row") + expect_snapshot(error = TRUE, { + make_splits(indices, df) + }) }) test_that("create a split from training and testing dataframes", { @@ -37,20 +39,18 @@ test_that("cannot create a split from empty training dataframe", { training <- tibble() testing <- tibble(x = c(5, 6)) - expect_error( - make_splits(training, testing), - "The analysis set must contain at least one row." - ) + expect_snapshot(error = TRUE, { + make_splits(training, testing) + }) }) test_that("cannot create a split from dataframes with different columns", { training <- tibble(x = c(1, 2, 3, 4)) testing <- tibble(y = c(5, 6)) - expect_error( - make_splits(training, testing), - "The analysis and assessment sets must have" - ) + expect_snapshot(error = TRUE, { + make_splits(training, testing) + }) }) test_that("improper argument", { diff --git a/tests/testthat/test-permutations.R b/tests/testthat/test-permutations.R index 91e3dfdf..7446f2b2 100644 --- a/tests/testthat/test-permutations.R +++ b/tests/testthat/test-permutations.R @@ -34,10 +34,18 @@ test_that("no assessment set", { }) test_that("bad args", { - expect_error(permutations(mtcars)) # no columns specified - expect_error(permutations(mtcars, foo)) # column doesn't exist - expect_error(permutations(mtcars, start_with("z"))) # column doesn't exist - expect_snapshot(error = TRUE, {permutations(mtcars, everything())}) # all columns + expect_snapshot(error = TRUE, { + permutations(mtcars) + }) + expect_snapshot(error = TRUE, { + permutations(mtcars, foo) + }) + expect_snapshot(error = TRUE, { + permutations(mtcars, start_with("z")) + }) + expect_snapshot(error = TRUE, { + permutations(mtcars, everything()) + }) }) test_that("printing", { diff --git a/tests/testthat/test-reg_intervals.R b/tests/testthat/test-reg_intervals.R index 283fd37f..017084bf 100644 --- a/tests/testthat/test-reg_intervals.R +++ b/tests/testthat/test-reg_intervals.R @@ -2,13 +2,10 @@ test_that("regression intervals", { skip_if_not_installed("broom") skip_on_cran() - expect_error( - { - set.seed(1) - int_1 <- reg_intervals(mpg ~ disp + wt, data = mtcars) - }, - regexp = NA - ) + expect_no_error({ + set.seed(1) + int_1 <- reg_intervals(mpg ~ disp + wt, data = mtcars) + }) expect_equal( names(int_1), @@ -36,16 +33,13 @@ test_that("regression intervals", { expect_true(all(int_2$term == "wt")) - expect_error( - reg_intervals(mpg ~ disp + wt, data = mtcars, model_fn = "potato"), - "`model_fn` must be one of" - ) - expect_error( - reg_intervals(mpg ~ disp + wt, data = mtcars, type = "random"), - "`type` must be one of" - ) - expect_error( - reg_intervals(mpg ~ disp + wt, data = mtcars, alpha = "a"), - "must be a single numeric value" - ) + expect_snapshot(error = TRUE, { + reg_intervals(mpg ~ disp + wt, data = mtcars, model_fn = "potato") + }) + expect_snapshot(error = TRUE, { + reg_intervals(mpg ~ disp + wt, data = mtcars, type = "random") + }) + expect_snapshot(error = TRUE, { + reg_intervals(mpg ~ disp + wt, data = mtcars, alpha = "a") + }) }) diff --git a/tests/testthat/test-reshuffle_rset.R b/tests/testthat/test-reshuffle_rset.R index 47412358..aba9f443 100644 --- a/tests/testthat/test-reshuffle_rset.R +++ b/tests/testthat/test-reshuffle_rset.R @@ -106,10 +106,15 @@ test_that("reshuffle_rset is working", { resample <- vfold_cv(mtcars, strata = cyl) attr(resample, "strata") <- TRUE - expect_snapshot_error(reshuffle_rset(resample)) + expect_snapshot(error = TRUE, { + reshuffle_rset(resample) + }) - expect_snapshot_error(reshuffle_rset(rset_subclasses[["manual_rset"]])) - - expect_snapshot_error(reshuffle_rset(rset_subclasses[["manual_rset"]]$splits[[1]])) + expect_snapshot(error = TRUE, { + reshuffle_rset(rset_subclasses[["manual_rset"]]) + }) + expect_snapshot(error = TRUE, { + reshuffle_rset(rset_subclasses[["manual_rset"]]$splits[[1]]) + }) }) diff --git a/tests/testthat/test-rolling_origin.R b/tests/testthat/test-rolling_origin.R index a7347d81..0afec660 100644 --- a/tests/testthat/test-rolling_origin.R +++ b/tests/testthat/test-rolling_origin.R @@ -99,9 +99,17 @@ test_that("lag", { (i + attr(rs5, "initial") - attr(rs5, "lag")):(i + attr(rs5, "initial") + attr(rs5, "assess") - 1) ) } - - expect_error(rolling_origin(drinks, initial = 5, lag = 6)) # lag must be less than training observations - expect_error(olling_origin(drinks, lag = 2.1)) # lag must be whole number + + skip_if_not_installed("modeldata") + data("drinks", package = "modeldata", envir = rlang::current_env()) + expect_snapshot(error = TRUE, { + # lag must be less than the number of training observations + rolling_origin(drinks, initial = 5, lag = 6) + }) + expect_snapshot(error = TRUE, { + # lag must be a whole number + rolling_origin(drinks, lag = 2.1) + }) }) test_that("rsplit labels", { diff --git a/tests/testthat/test-rset.R b/tests/testthat/test-rset.R index c09e0cab..7a38bf00 100644 --- a/tests/testthat/test-rset.R +++ b/tests/testthat/test-rset.R @@ -1,22 +1,24 @@ test_that("bad args", { - expect_error( + expect_snapshot(error = TRUE, { new_rset(car_folds$splits[1:2], car_folds$id) - ) - expect_error( + }) + expect_snapshot(error = TRUE, { new_rset(car_folds$splits, car_folds["splits"]) - ) - expect_error( + }) + expect_snapshot(error = TRUE, { new_rset(car_folds$splits, car_folds$splits) - ) - expect_snapshot(error = TRUE, {new_rset(list(1), "x")}) + }) + expect_snapshot(error = TRUE, { + new_rset(list(1), "x") + }) args <- list(a = 1, b = 2, 3) - expect_error( + expect_snapshot(error = TRUE, { new_rset( car_folds$splits, car_folds$id, attrib = args ) - ) + }) }) test_that("rset with attributes", { @@ -47,6 +49,10 @@ test_that("rset with additional classes", { test_that("not an rsplit", { folds <- vfold_cv(mtcars) - expect_error(analysis(folds$splits[1])) - expect_error(assessment(folds$splits[1])) + expect_snapshot(error = TRUE, { + analysis(folds$splits[1]) + }) + expect_snapshot(error = TRUE, { + assessment(folds$splits[1]) + }) }) diff --git a/tests/testthat/test-rsplit.R b/tests/testthat/test-rsplit.R index 4d452ea2..77b3952d 100644 --- a/tests/testthat/test-rsplit.R +++ b/tests/testthat/test-rsplit.R @@ -14,12 +14,24 @@ test_that("simple rsplit with matrices", { }) test_that("bad inputs", { - expect_error(rsplit(as.list(dat1), 1:2, 4:5)) - expect_error(rsplit(dat1, letters[1:2], 4:5)) - expect_error(rsplit(as.list(dat1), 1:2, letters[4:5])) - expect_error(rsplit(as.list(dat1), -1:2, 4:5)) - expect_error(rsplit(as.list(dat1), 1:2, -4:5)) - expect_error(rsplit(as.list(dat1), integer(0), 4:5)) + expect_snapshot(error = TRUE, { + rsplit(as.list(dat1), 1:2, 4:5) + }) + expect_snapshot(error = TRUE, { + rsplit(dat1, letters[1:2], 4:5) + }) + expect_snapshot(error = TRUE, { + rsplit(as.list(dat1), 1:2, letters[4:5]) + }) + expect_snapshot(error = TRUE, { + rsplit(as.list(dat1), -1:2, 4:5) + }) + expect_snapshot(error = TRUE, { + rsplit(as.list(dat1), 1:2, -4:5) + }) + expect_snapshot(error = TRUE, { + rsplit(as.list(dat1), integer(0), 4:5) + }) }) test_that("as.data.frame", { diff --git a/tests/testthat/test-slide.R b/tests/testthat/test-slide.R index 2655e303..118a5c47 100644 --- a/tests/testthat/test-slide.R +++ b/tests/testthat/test-slide.R @@ -148,32 +148,60 @@ test_that("can use incomplete windows at the beginning", { }) test_that("`data` is validated", { - expect_error(sliding_window(1), "`data` must be a data frame") + expect_snapshot(error = TRUE, { + sliding_window(1) + }) }) test_that("`lookback` is validated", { - expect_error(sliding_window(data.frame(), lookback = -1), "`lookback` must be positive, or zero") - expect_error(sliding_window(data.frame(), lookback = "a"), "`lookback` must be an integer") - expect_error(sliding_window(data.frame(), lookback = c(1, 2)), "`lookback` must have size 1") - expect_error(sliding_window(data.frame(), lookback = NA), "`lookback` must be an integer") + expect_snapshot(error = TRUE, { + sliding_window(data.frame(), lookback = -1) + }) + expect_snapshot(error = TRUE, { + sliding_window(data.frame(), lookback = "a") + }) + expect_snapshot(error = TRUE, { + sliding_window(data.frame(), lookback = c(1, 2)) + }) + expect_snapshot(error = TRUE, { + sliding_window(data.frame(), lookback = NA) + }) }) test_that("`assess_start` is validated", { - expect_error(sliding_window(data.frame(), assess_start = -1), "`assess_start` must be positive") - expect_error(sliding_window(data.frame(), assess_start = "a"), "`assess_start` must be an integer") - expect_error(sliding_window(data.frame(), assess_start = c(1, 2)), "`assess_start` must have size 1") - expect_error(sliding_window(data.frame(), assess_start = NA), "`assess_start` must be an integer") + expect_snapshot(error = TRUE, { + sliding_window(data.frame(), assess_start = -1) + }) + expect_snapshot(error = TRUE, { + sliding_window(data.frame(), assess_start = "a") + }) + expect_snapshot(error = TRUE, { + sliding_window(data.frame(), assess_start = c(1, 2)) + }) + expect_snapshot(error = TRUE, { + sliding_window(data.frame(), assess_start = NA) + }) }) test_that("`assess_stop` is validated", { - expect_error(sliding_window(data.frame(), assess_stop = -1), "`assess_stop` must be positive") - expect_error(sliding_window(data.frame(), assess_stop = "a"), "`assess_stop` must be an integer") - expect_error(sliding_window(data.frame(), assess_stop = c(1, 2)), "`assess_stop` must have size 1") - expect_error(sliding_window(data.frame(), assess_stop = NA), "`assess_stop` must be an integer") + expect_snapshot(error = TRUE, { + sliding_window(data.frame(), assess_stop = -1) + }) + expect_snapshot(error = TRUE, { + sliding_window(data.frame(), assess_stop = "a") + }) + expect_snapshot(error = TRUE, { + sliding_window(data.frame(), assess_stop = c(1, 2)) + }) + expect_snapshot(error = TRUE, { + sliding_window(data.frame(), assess_stop = NA) + }) }) test_that("`assess_start` must be before or equal to `assess_stop`", { - expect_error(sliding_window(data.frame(), assess_start = 2, assess_stop = 1), "less than or equal to") + expect_snapshot(error = TRUE, { + sliding_window(data.frame(), assess_start = 2, assess_stop = 1) + }) }) # ------------------------------------------------------------------------------ @@ -336,12 +364,16 @@ test_that("can use incomplete windows at the beginning", { }) test_that("`data` is validated", { - expect_error(sliding_index(1), "`data` must be a data frame") + expect_snapshot(error = TRUE, { + sliding_index(1) + }) }) test_that("`index` is validated", { df <- data.frame(x = 1:2) - expect_error(sliding_index(df, y)) + expect_snapshot(error = TRUE, { + sliding_index(df, y) + }) }) # ------------------------------------------------------------------------------ @@ -504,10 +536,14 @@ test_that("can use incomplete windows at the beginning", { }) test_that("`data` is validated", { - expect_error(sliding_period(1), "`data` must be a data frame") + expect_snapshot(error = TRUE, { + sliding_period(1) + }) }) test_that("`index` is validated", { df <- data.frame(x = 1:2) - expect_error(sliding_period(df, y)) + expect_snapshot(error = TRUE, { + sliding_period(df, y) + }) }) diff --git a/tests/testthat/test-validation_split.R b/tests/testthat/test-validation_split.R index 3c455d75..10ddeebb 100644 --- a/tests/testthat/test-validation_split.R +++ b/tests/testthat/test-validation_split.R @@ -259,8 +259,12 @@ test_that("strata", { test_that("bad args", { withr::local_options(lifecycle_verbosity = "quiet") - expect_error(validation_split(warpbreaks, strata = warpbreaks$tension)) - expect_error(validation_split(warpbreaks, strata = c("tension", "wool"))) + expect_snapshot(error = TRUE, { + validation_split(warpbreaks, strata = warpbreaks$tension) + }) + expect_snapshot(error = TRUE, { + validation_split(warpbreaks, strata = c("tension", "wool")) + }) }) test_that("printing", { diff --git a/tests/testthat/test-vfold.R b/tests/testthat/test-vfold.R index 51c00ba4..9b81bae1 100644 --- a/tests/testthat/test-vfold.R +++ b/tests/testthat/test-vfold.R @@ -76,16 +76,36 @@ test_that("strata", { test_that("bad args", { - expect_error(vfold_cv(iris, strata = iris$Species)) - expect_error(vfold_cv(iris, strata = c("Species", "Sepal.Width"))) - expect_snapshot_error(vfold_cv(iris, v = -500)) - expect_snapshot_error(vfold_cv(iris, v = 1)) - expect_snapshot_error(vfold_cv(iris, v = NULL)) - expect_snapshot_error(vfold_cv(iris, v = 500)) - expect_snapshot_error(vfold_cv(iris, v = 150, repeats = 2)) - expect_snapshot_error(vfold_cv(Orange, repeats = 0)) - expect_snapshot_error(vfold_cv(Orange, repeats = NULL)) - expect_snapshot(error = TRUE, vfold_cv(mtcars, v = nrow(mtcars))) + expect_snapshot(error = TRUE, { + vfold_cv(iris, strata = iris$Species) + }) + expect_snapshot(error = TRUE, { + vfold_cv(iris, strata = c("Species", "Sepal.Width")) + }) + expect_snapshot(error = TRUE, { + vfold_cv(iris, v = -500) + }) + expect_snapshot(error = TRUE, { + vfold_cv(iris, v = 1) + }) + expect_snapshot(error = TRUE, { + vfold_cv(iris, v = NULL) + }) + expect_snapshot(error = TRUE, { + vfold_cv(iris, v = 500) + }) + expect_snapshot(error = TRUE, { + vfold_cv(iris, v = 150, repeats = 2) + }) + expect_snapshot(error = TRUE, { + vfold_cv(Orange, repeats = 0) + }) + expect_snapshot(error = TRUE, { + vfold_cv(Orange, repeats = NULL) + }) + expect_snapshot(error = TRUE, { + vfold_cv(mtcars, v = nrow(mtcars)) + }) }) test_that("printing", { @@ -108,14 +128,30 @@ test_that("rsplit labels", { }) test_that("grouping -- bad args", { - expect_error(group_vfold_cv(warpbreaks, group = warpbreaks$tension)) - expect_error(group_vfold_cv(warpbreaks, group = c("tension", "wool"))) - expect_error(group_vfold_cv(warpbreaks, group = "tensio")) - expect_error(group_vfold_cv(warpbreaks)) - expect_error(group_vfold_cv(warpbreaks, group = "tension", v = 10)) - expect_snapshot_error(group_vfold_cv(dat1, c, v = 4, repeats = 4)) - expect_snapshot_error(group_vfold_cv(dat1, c, repeats = 4)) - expect_snapshot(error = TRUE, group_vfold_cv(Orange, v = 1, group = "Tree")) + expect_snapshot(error = TRUE, { + group_vfold_cv(warpbreaks, group = warpbreaks$tension) + }) + expect_snapshot(error = TRUE, { + group_vfold_cv(warpbreaks, group = c("tension", "wool")) + }) + expect_snapshot(error = TRUE, { + group_vfold_cv(warpbreaks, group = "tensio") + }) + expect_snapshot(error = TRUE, { + group_vfold_cv(warpbreaks) + }) + expect_snapshot(error = TRUE, { + group_vfold_cv(warpbreaks, group = "tension", v = 10) + }) + expect_snapshot(error = TRUE, { + group_vfold_cv(dat1, c, v = 4, repeats = 4) + }) + expect_snapshot(error = TRUE, { + group_vfold_cv(dat1, c, repeats = 4) + }) + expect_snapshot(error = TRUE, { + group_vfold_cv(Orange, v = 1, group = "Tree") + }) }) @@ -285,7 +321,7 @@ test_that("grouping -- strata", { ) expect_true(all(good_holdout)) - expect_snapshot_warning( + expect_snapshot( group_vfold_cv(sample_data, group, strata = outcome) ) @@ -325,7 +361,7 @@ test_that("grouping -- strata", { ) expect_true(all(good_holdout)) - expect_snapshot_warning( + expect_snapshot( group_vfold_cv(sample_data, group, strata = outcome) )