tests: more snapshot tests

Author: dshemetov

NAMESPACE

@@ -214,15 +214,18 @@ import(distributional)
 import(epiprocess)
 import(parsnip)
 import(recipes)
+importFrom(checkmate,assert)
+importFrom(checkmate,assert_character)
 importFrom(checkmate,assert_class)
+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,test_character)
-importFrom(checkmate,test_date)
-importFrom(checkmate,test_function)
-importFrom(checkmate,test_integerish)
-importFrom(checkmate,test_logical)
-importFrom(checkmate,test_numeric)
-importFrom(checkmate,test_scalar)
+importFrom(checkmate,assert_scalar)
 importFrom(cli,cli_abort)
 importFrom(cli,cli_warn)
 importFrom(dplyr,across)
@@ -273,24 +276,12 @@ importFrom(rlang,caller_arg)
 importFrom(rlang,caller_env)
 importFrom(rlang,enquo)
 importFrom(rlang,enquos)
-importFrom(rlang,env_get_list)
 importFrom(rlang,expr)
 importFrom(rlang,global_env)
 importFrom(rlang,inject)
-importFrom(rlang,is_call)
-importFrom(rlang,is_character)
-importFrom(rlang,is_closure)
-importFrom(rlang,is_environment)
-importFrom(rlang,is_formula)
-importFrom(rlang,is_function)
-importFrom(rlang,is_list)
 importFrom(rlang,is_logical)
-importFrom(rlang,is_missing)
 importFrom(rlang,is_null)
-importFrom(rlang,is_string)
-importFrom(rlang,is_symbol)
 importFrom(rlang,is_true)
-importFrom(rlang,is_vector)
 importFrom(rlang,set_names)
 importFrom(rlang,sym)
 importFrom(stats,as.formula)

man/autoplot-epipred.Rd

@@ -1,30 +1,30 @@
 test_that("arx_args checks inputs", {
   expect_s3_class(arx_args_list(), c("arx_fcast", "alist"))
-  expect_error(arx_args_list(ahead = c(0, 4)))
-  expect_error(arx_args_list(n_training = c(28, 65)))
+  expect_snapshot(error = TRUE, arx_args_list(ahead = c(0, 4)))
+  expect_snapshot(error = TRUE, arx_args_list(n_training = c(28, 65)))
 
-  expect_error(arx_args_list(ahead = -1))
-  expect_error(arx_args_list(ahead = 1.5))
-  expect_error(arx_args_list(n_training = -1))
-  expect_error(arx_args_list(n_training = 1.5))
-  expect_error(arx_args_list(lags = c(-1, 0)))
-  expect_error(arx_args_list(lags = list(c(1:5, 6.5), 2:8)))
+  expect_snapshot(error = TRUE, arx_args_list(ahead = -1))
+  expect_snapshot(error = TRUE, arx_args_list(ahead = 1.5))
+  expect_snapshot(error = TRUE, arx_args_list(n_training = -1))
+  expect_snapshot(error = TRUE, arx_args_list(n_training = 1.5))
+  expect_snapshot(error = TRUE, arx_args_list(lags = c(-1, 0)))
+  expect_snapshot(error = TRUE, arx_args_list(lags = list(c(1:5, 6.5), 2:8)))
 
-  expect_error(arx_args_list(symmetrize = 4))
-  expect_error(arx_args_list(nonneg = 4))
+  expect_snapshot(error = TRUE, arx_args_list(symmetrize = 4))
+  expect_snapshot(error = TRUE, arx_args_list(nonneg = 4))
 
-  expect_error(arx_args_list(quantile_levels = -.1))
-  expect_error(arx_args_list(quantile_levels = 1.1))
+  expect_snapshot(error = TRUE, arx_args_list(quantile_levels = -.1))
+  expect_snapshot(error = TRUE, arx_args_list(quantile_levels = 1.1))
   expect_type(arx_args_list(quantile_levels = NULL), "list")
 
-  expect_error(arx_args_list(target_date = "2022-01-01"))
+  expect_snapshot(error = TRUE, arx_args_list(target_date = "2022-01-01"))
   expect_identical(
     arx_args_list(target_date = as.Date("2022-01-01"))$target_date,
     as.Date("2022-01-01")
   )
 
-  expect_error(arx_args_list(n_training_min = "de"))
-  expect_error(arx_args_list(epi_keys = 1))
+  expect_snapshot(error = TRUE, arx_args_list(n_training_min = "de"))
+  expect_snapshot(error = TRUE, arx_args_list(epi_keys = 1))
 
   expect_warning(arx_args_list(
     forecast_date = as.Date("2022-01-01"),
@@ -58,7 +58,7 @@ test_that("arx forecaster disambiguates quantiles", {
     sort(unique(tlist))
   )
   alist <- c(.1, .3, .5, .7, .9) # neither default, and different,
-  expect_error(compare_quantile_args(alist, tlist))
+  expect_snapshot(error = TRUE, compare_quantile_args(alist, tlist))
 })
 
 test_that("arx_lags_validator handles named & unnamed lists as expected", {
@@ -94,7 +94,7 @@ test_that("arx_lags_validator handles named & unnamed lists as expected", {
   )
 
   # More lags than predictors - Error
-  expect_error(arx_lags_validator(pred_vec, lags_finit_fn_switch2))
+  expect_snapshot(error = TRUE, arx_lags_validator(pred_vec, lags_finit_fn_switch2))
 
   # Unnamed list of lags
   lags_init_un <- list(c(0, 7, 14), c(0, 1, 2, 3, 7, 14))
@@ -115,5 +115,5 @@ test_that("arx_lags_validator handles named & unnamed lists as expected", {
   # Try use a name not in predictors - Error
   lags_init_other_name <- list(death_rate = c(0, 7, 14), test_var = c(0, 1, 2, 3, 7, 14))
 
-  expect_error(arx_lags_validator(pred_vec, lags_init_other_name))
+  expect_snapshot(error = TRUE, arx_lags_validator(pred_vec, lags_init_other_name))
 })

tests/testthat/test-arx_args_list.R

@@ -1,24 +1,24 @@
 test_that("arx_class_args checks inputs", {
   expect_s3_class(arx_class_args_list(), c("arx_class", "alist"))
-  expect_error(arx_class_args_list(ahead = c(0, 4)))
-  expect_error(arx_class_args_list(n_training = c(28, 65)))
+  expect_snapshot(error = TRUE, arx_class_args_list(ahead = c(0, 4)))
+  expect_snapshot(error = TRUE, arx_class_args_list(n_training = c(28, 65)))
 
-  expect_error(arx_class_args_list(ahead = -1))
-  expect_error(arx_class_args_list(ahead = 1.5))
-  expect_error(arx_class_args_list(n_training = -1))
-  expect_error(arx_class_args_list(n_training = 1.5))
-  expect_error(arx_class_args_list(lags = c(-1, 0)))
-  expect_error(arx_class_args_list(lags = list(c(1:5, 6.5), 2:8)))
+  expect_snapshot(error = TRUE, arx_class_args_list(ahead = -1))
+  expect_snapshot(error = TRUE, arx_class_args_list(ahead = 1.5))
+  expect_snapshot(error = TRUE, arx_class_args_list(n_training = -1))
+  expect_snapshot(error = TRUE, arx_class_args_list(n_training = 1.5))
+  expect_snapshot(error = TRUE, arx_class_args_list(lags = c(-1, 0)))
+  expect_snapshot(error = TRUE, arx_class_args_list(lags = list(c(1:5, 6.5), 2:8)))
 
 
-  expect_error(arx_class_args_list(target_date = "2022-01-01"))
+  expect_snapshot(error = TRUE, arx_class_args_list(target_date = "2022-01-01"))
   expect_identical(
     arx_class_args_list(target_date = as.Date("2022-01-01"))$target_date,
     as.Date("2022-01-01")
   )
 
-  expect_error(arx_class_args_list(n_training_min = "de"))
-  expect_error(arx_class_args_list(epi_keys = 1))
+  expect_snapshot(error = TRUE, arx_class_args_list(n_training_min = "de"))
+  expect_snapshot(error = TRUE, arx_class_args_list(epi_keys = 1))
 
   expect_warning(arx_class_args_list(
     forecast_date = as.Date("2022-01-01"),

tests/testthat/test-arx_cargs_list.R

@@ -25,5 +25,5 @@ test_that("bake method works in all cases", {
   expect_s3_class(bake(prep(r, edf), NULL, composition = "tibble"), "tbl_df")
   expect_s3_class(bake(prep(r, edf), NULL, composition = "data.frame"), "data.frame")
   # can't be a matrix because time_value/geo_value aren't numeric
-  expect_error(bake(prep(r, edf), NULL, composition = "matrix"))
+  expect_snapshot(error = TRUE, bake(prep(r, edf), NULL, composition = "matrix"))
 })

tests/testthat/test-bake-method.R

@@ -7,7 +7,7 @@ test_that("training set validation works", {
   expect_silent(validate_meta_match(template, template, "time_type", "blah"))
   attr(t1, "metadata")$geo_type <- "county"
   expect_warning(validate_meta_match(t1, template, "geo_type"), "county")
-  expect_error(validate_meta_match(t1, template, "geo_type", "abort"), "county")
+  expect_snapshot(error = TRUE, validate_meta_match(t1, template, "geo_type", "abort"), "county")
 
 
   expect_identical(template, epi_check_training_set(template, rec))
@@ -25,5 +25,5 @@ test_that("training set validation works", {
   expect_warning(t4 <- epi_check_training_set(t3, rec))
   expect_identical(rec$template, t4)
   attr(rec$template, "metadata")$other_keys <- "missing_col"
-  expect_error(epi_check_training_set(t4, rec), "missing_col")
+  expect_snapshot(error = TRUE, epi_check_training_set(t4, rec), "missing_col")
 })

tests/testthat/test-check-training-set.R

@@ -23,15 +23,16 @@ test_that("check_enough_train_data works on pooled data", {
       bake(new_data = NULL)
   )
   # Check both column don't have enough data
-  expect_error(
+  expect_snapshot(
+    error = TRUE,
     epi_recipe(toy_epi_df) %>%
       check_enough_train_data(x, y, n = 2 * n + 1, drop_na = FALSE) %>%
       prep(toy_epi_df) %>%
-      bake(new_data = NULL),
-    regexp = "The following columns don't have enough data"
+      bake(new_data = NULL)
   )
   # Check drop_na works
-  expect_error(
+  expect_snapshot(
+    error = TRUE,
     epi_recipe(toy_epi_df) %>%
       check_enough_train_data(x, y, n = 2 * n - 1, drop_na = TRUE) %>%
       prep(toy_epi_df) %>%
@@ -48,15 +49,16 @@ test_that("check_enough_train_data works on unpooled data", {
       bake(new_data = NULL)
   )
   # Check one column don't have enough data
-  expect_error(
+  expect_snapshot(
+    error = TRUE,
     epi_recipe(toy_epi_df) %>%
       check_enough_train_data(x, y, n = n + 1, epi_keys = "geo_value", drop_na = FALSE) %>%
       prep(toy_epi_df) %>%
-      bake(new_data = NULL),
-    regexp = "The following columns don't have enough data"
+      bake(new_data = NULL)
   )
   # Check drop_na works
-  expect_error(
+  expect_snapshot(
+    error = TRUE,
     epi_recipe(toy_epi_df) %>%
       check_enough_train_data(x, y, n = 2 * n - 3, epi_keys = "geo_value", drop_na = TRUE) %>%
       prep(toy_epi_df) %>%
@@ -114,7 +116,8 @@ test_that("check_enough_train_data works with all_predictors() downstream of con
       prep(toy_epi_df) %>%
       bake(new_data = NULL)
   )
-  expect_error(
+  expect_snapshot(
+    error = TRUE,
     epi_recipe(toy_epi_df) %>%
       step_epi_lag(x, lag = c(1, 2)) %>%
       check_enough_train_data(all_predictors(), y, n = 2 * n - 5) %>%

tests/testthat/test-check_enough_train_data.R

@@ -1,13 +1,13 @@
 library(distributional)
 
 test_that("constructor returns reasonable quantiles", {
-  expect_error(new_quantiles(rnorm(5), rnorm(5)))
+  expect_snapshot(error = TRUE, new_quantiles(rnorm(5), rnorm(5)))
   expect_silent(new_quantiles(sort(rnorm(5)), sort(runif(5))))
-  expect_error(new_quantiles(sort(rnorm(5)), sort(runif(2))))
+  expect_snapshot(error = TRUE, new_quantiles(sort(rnorm(5)), sort(runif(2))))
   expect_silent(new_quantiles(1:5, 1:5 / 10))
-  expect_error(new_quantiles(c(2, 1, 3, 4, 5), c(.1, .1, .2, .5, .8)))
-  expect_error(new_quantiles(c(2, 1, 3, 4, 5), c(.1, .15, .2, .5, .8)))
-  expect_error(new_quantiles(c(1, 2, 3), c(.1, .2, 3)))
+  expect_snapshot(error = TRUE, new_quantiles(c(2, 1, 3, 4, 5), c(.1, .1, .2, .5, .8)))
+  expect_snapshot(error = TRUE, new_quantiles(c(2, 1, 3, 4, 5), c(.1, .15, .2, .5, .8)))
+  expect_snapshot(error = TRUE, new_quantiles(c(1, 2, 3), c(.1, .2, 3)))
 })
 
 
@@ -106,6 +106,6 @@ test_that("arithmetic works on quantiles", {
   expect_identical(dstn / 4, dstn2)
   expect_identical((1 / 4) * dstn, dstn2)
 
-  expect_error(sum(dstn))
-  expect_error(suppressWarnings(dstn + distributional::dist_normal()))
+  expect_snapshot(error = TRUE, sum(dstn))
+  expect_snapshot(error = TRUE, suppressWarnings(dstn + distributional::dist_normal()))
 })

tests/testthat/test-dist_quantiles.R

@@ -1,11 +1,11 @@
 test_that("enframer errors/works as needed", {
   template1 <- data.frame(aa = 1:5, a = NA, b = NA, c = NA)
   template2 <- data.frame(aa = 1:5, a = 2:6, b = 2:6, c = 2:6)
-  expect_error(enframer(1:5, letters[1]))
-  expect_error(enframer(data.frame(a = 1:5), 1:3))
-  expect_error(enframer(data.frame(a = 1:5), letters[1:3]))
+  expect_snapshot(error = TRUE, enframer(1:5, letters[1]))
+  expect_snapshot(error = TRUE, enframer(data.frame(a = 1:5), 1:3))
+  expect_snapshot(error = TRUE, enframer(data.frame(a = 1:5), letters[1:3]))
   expect_identical(enframer(data.frame(aa = 1:5), letters[1:3]), template1)
-  expect_error(enframer(data.frame(aa = 1:5), letters[1:2], fill = 1:4))
+  expect_snapshot(error = TRUE, enframer(data.frame(aa = 1:5), letters[1:2], fill = 1:4))
   expect_identical(
     enframer(data.frame(aa = 1:5), letters[1:3], fill = 2:6),
     template2

tests/testthat/test-enframer.R

@@ -155,6 +155,6 @@ test_that("add/update/adjust/remove epi_recipe works as intended", {
 
 
   wf <- remove_epi_recipe(wf)
-  expect_error(workflows::extract_preprocessor(wf)$steps)
+  expect_snapshot(error = TRUE, workflows::extract_preprocessor(wf)$steps)
   expect_equal(wf$pre$actions$recipe$recipe, NULL)
 })

tests/testthat/test-epi_recipe.R

@@ -59,7 +59,7 @@ test_that("model can be added/updated/removed from epi_workflow", {
   expect_equal(class(model_spec2), c("linear_reg", "model_spec"))
 
   wf <- remove_model(wf)
-  expect_error(extract_spec_parsnip(wf))
+  expect_snapshot(error = TRUE, extract_spec_parsnip(wf))
   expect_equal(wf$fit$actions$model$spec, NULL)
 })
 
@@ -103,7 +103,7 @@ test_that("forecast method errors when workflow not fit", {
     step_epi_naomit()
   wf <- epi_workflow(r, parsnip::linear_reg())
 
-  expect_error(forecast(wf))
+  expect_snapshot(error = TRUE, forecast(wf))
 })
 
 test_that("fit method does not silently drop the class", {

tests/testthat/test-epi_workflow.R

@@ -4,27 +4,27 @@ test_that("layer argument extractor works", {
     layer_residual_quantiles(quantile_levels = c(0.0275, 0.975), symmetrize = FALSE) %>%
     layer_naomit(.pred)
 
-  expect_error(extract_argument(f$layers[[1]], "uhoh", "bubble"))
-  expect_error(extract_argument(f$layers[[1]], "layer_predict", "bubble"))
+  expect_snapshot(error = TRUE, extract_argument(f$layers[[1]], "uhoh", "bubble"))
+  expect_snapshot(error = TRUE, extract_argument(f$layers[[1]], "layer_predict", "bubble"))
   expect_identical(
     extract_argument(f$layers[[2]], "layer_residual_quantiles", "quantile_levels"),
     c(0.0275, 0.9750)
   )
 
-  expect_error(extract_argument(f, "layer_thresh", "quantile_levels"))
+  expect_snapshot(error = TRUE, extract_argument(f, "layer_thresh", "quantile_levels"))
   expect_identical(
     extract_argument(f, "layer_residual_quantiles", "quantile_levels"),
     c(0.0275, 0.9750)
   )
 
   wf <- epi_workflow(postprocessor = f)
-  expect_error(extract_argument(epi_workflow(), "layer_residual_quantiles", "quantile_levels"))
+  expect_snapshot(error = TRUE, extract_argument(epi_workflow(), "layer_residual_quantiles", "quantile_levels"))
   expect_identical(
     extract_argument(wf, "layer_residual_quantiles", "quantile_levels"),
     c(0.0275, 0.9750)
   )
 
-  expect_error(extract_argument(wf, "layer_predict", c("type", "opts")))
+  expect_snapshot(error = TRUE, extract_argument(wf, "layer_predict", c("type", "opts")))
 })
 
 test_that("recipe argument extractor works", {
@@ -41,19 +41,19 @@ test_that("recipe argument extractor works", {
     step_naomit(all_outcomes(), skip = TRUE)
 
 
-  expect_error(extract_argument(r$steps[[1]], "uhoh", "bubble"))
-  expect_error(extract_argument(r$steps[[1]], "step_epi_lag", "bubble"))
+  expect_snapshot(error = TRUE, extract_argument(r$steps[[1]], "uhoh", "bubble"))
+  expect_snapshot(error = TRUE, extract_argument(r$steps[[1]], "step_epi_lag", "bubble"))
   expect_identical(extract_argument(r$steps[[2]], "step_epi_ahead", "ahead"), 7L)
 
 
-  expect_error(extract_argument(r, "step_lightly", "quantile_levels"))
+  expect_snapshot(error = TRUE, extract_argument(r, "step_lightly", "quantile_levels"))
   expect_identical(
     extract_argument(r, "step_epi_lag", "lag"),
     list(c(0L, 7L, 14L), c(0L, 7L, 14L))
   )
 
   wf <- epi_workflow(preprocessor = r)
-  expect_error(extract_argument(epi_workflow(), "step_epi_lag", "lag"))
+  expect_snapshot(error = TRUE, extract_argument(epi_workflow(), "step_epi_lag", "lag"))
   expect_identical(
     extract_argument(wf, "step_epi_lag", "lag"),
     list(c(0L, 7L, 14L), c(0L, 7L, 14L))