expect_warning() -> expect_snapshot()

Author: simonpcouch

tests/testthat/_snaps/boost_tree_C5.0.md

@@ -15,3 +15,21 @@
       Error in `multi_predict()`:
       ! Please use `new_data` instead of `newdata`.
 
+# argument checks for data dimensions
+
+    Code
+      f_fit <- spec %>% fit(species ~ ., data = penguins)
+    Condition
+      Warning:
+      ! 1000 samples were requested but there were 333 rows in the data.
+      i 333 will be used.
+
+---
+
+    Code
+      xy_fit <- spec %>% fit_xy(x = penguins[, -1], y = penguins$species)
+    Condition
+      Warning:
+      ! 1000 samples were requested but there were 333 rows in the data.
+      i 333 will be used.
+

tests/testthat/_snaps/boost_tree_xgboost.md

@@ -34,6 +34,16 @@
 
 # early stopping
 
+    Code
+      reg_fit <- boost_tree(trees = 20, stop_iter = 30, mode = "regression") %>%
+        set_engine("xgboost", validation = 0.1) %>% fit(mpg ~ ., data = mtcars[-(1:4),
+      ])
+    Condition
+      Warning:
+      `early_stop` was reduced to 19.
+
+---
+
     Code
       reg_fit <- boost_tree(trees = 20, stop_iter = 0, mode = "regression") %>%
         set_engine("xgboost", validation = 0.1) %>% fit(mpg ~ ., data = mtcars[-(1:4),
@@ -50,6 +60,24 @@
       Warning:
       `event_level` can only be set for binary outcomes.
 
+# argument checks for data dimensions
+
+    Code
+      f_fit <- spec %>% fit(species ~ ., data = penguins, control = ctrl)
+    Condition
+      Warning:
+      ! 1000 samples were requested but there were 333 rows in the data.
+      i 333 will be used.
+
+---
+
+    Code
+      xy_fit <- spec %>% fit_xy(x = penguins_dummy, y = penguins$species, control = ctrl)
+    Condition
+      Warning:
+      ! 1000 samples were requested but there were 333 rows in the data.
+      i 333 will be used.
+
 # count/proportion parameters
 
     Code

tests/testthat/_snaps/convert_data.md

@@ -7,6 +7,14 @@
       Error in `na.fail.default()`:
       ! missing values in object
 
+# numeric x and factor y
+
+    Code
+      expected <- glm(class ~ ., data = hpc, x = TRUE, y = TRUE, family = binomial())
+    Condition
+      Warning:
+      glm.fit: fitted probabilities numerically 0 or 1 occurred
+
 # bad args
 
     Code

tests/testthat/_snaps/failed_models.md

@@ -0,0 +1,51 @@
+# numeric model
+
+    Code
+      num_res <- predict(lm_mod, hpc_bad[1:11, -1])
+    Condition
+      Warning:
+      Model fit failed; cannot make predictions.
+
+---
+
+    Code
+      ci_res <- predict(lm_mod, hpc_bad[1:11, -1], type = "conf_int")
+    Condition
+      Warning:
+      Model fit failed; cannot make predictions.
+
+---
+
+    Code
+      pi_res <- predict(lm_mod, hpc_bad[1:11, -1], type = "pred_int")
+    Condition
+      Warning:
+      Model fit failed; cannot make predictions.
+
+# classification model
+
+    Code
+      cls_res <- predict(log_reg, lending_club %>% dplyr::slice(1:7) %>% dplyr::select(
+        -Class))
+    Condition
+      Warning:
+      Model fit failed; cannot make predictions.
+
+---
+
+    Code
+      prb_res <- predict(log_reg, lending_club %>% dplyr::slice(1:7) %>% dplyr::select(
+        -Class), type = "prob")
+    Condition
+      Warning:
+      Model fit failed; cannot make predictions.
+
+---
+
+    Code
+      ci_res <- predict(log_reg, lending_club %>% dplyr::slice(1:7) %>% dplyr::select(
+        -Class), type = "conf_int")
+    Condition
+      Warning:
+      Model fit failed; cannot make predictions.
+

tests/testthat/_snaps/linear_reg.md

@@ -137,6 +137,14 @@
       Error in `show_engines()`:
       ! No results found for model function "x".
 
+# lm can handle rankdeficient predictions
+
+    Code
+      preds <- linear_reg() %>% fit(y ~ ., data = data) %>% predict(new_data = data2)
+    Condition
+      Warning in `predict.lm()`:
+      prediction from rank-deficient fit; consider predict(., rankdeficient="NA")
+
 # check_args() works
 
     Code

tests/testthat/_snaps/mlp.md

@@ -32,6 +32,25 @@
       x Engine "wat?" is not supported for `mlp()`
       i See `show_engines("mlp")`.
 
+---
+
+    Code
+      translate(mlp(mode = "regression") %>% set_engine("nnet", formula = y ~ x))
+    Condition
+      Warning:
+      The argument `formula` cannot be manually modified and was removed.
+    Output
+      Single Layer Neural Network Model Specification (regression)
+      
+      Main Arguments:
+        hidden_units = 5
+      
+      Computational engine: nnet 
+      
+      Model fit template:
+      nnet::nnet(formula = missing_arg(), data = missing_arg(), size = 5, 
+          trace = FALSE, linout = TRUE)
+
 ---
 
     Code

tests/testthat/_snaps/multinom_reg.md

@@ -40,6 +40,26 @@
       Error in `set_engine()`:
       ! Missing engine. Possible mode/engine combinations are: classification {glmnet, spark, keras, nnet, brulee}.
 
+---
+
+    Code
+      translate(multinom_reg(penalty = 0.1) %>% set_engine("glmnet", x = hpc[, 1:3],
+      y = hpc$class))
+    Condition
+      Warning:
+      The argument `x, y` cannot be manually modified and was removed.
+    Output
+      Multinomial Regression Model Specification (classification)
+      
+      Main Arguments:
+        penalty = 0.1
+      
+      Computational engine: glmnet 
+      
+      Model fit template:
+      glmnet::glmnet(x = missing_arg(), y = missing_arg(), weights = missing_arg(), 
+          family = "multinomial")
+
 # check_args() works
 
     Code

tests/testthat/_snaps/nullmodel.md

@@ -23,6 +23,22 @@
       Error in `null_model()`:
       ! unused argument (formula = y ~ x)
 
+---
+
+    Code
+      translate(null_model(mode = "regression") %>% set_engine("parsnip", x = hpc[, 1:
+        3], y = hpc$class))
+    Condition
+      Warning:
+      The argument `x, y` cannot be manually modified and was removed.
+    Output
+      Null Model Specification (regression)
+      
+      Computational engine: parsnip 
+      
+      Model fit template:
+      parsnip::nullmodel(x = missing_arg(), y = missing_arg())
+
 # nullmodel execution
 
     Code

tests/testthat/_snaps/rand_forest_ranger.md

@@ -46,6 +46,32 @@
       Warning in `sqrt()`:
       NaNs produced
 
+# ranger classification intervals
+
+    Code
+      rgr_se <- predict(extract_fit_engine(lc_fit), data = tail(lending_club), type = "se")$
+        se
+    Condition
+      Warning in `rInfJack()`:
+      Sample size <=20, no calibration performed.
+      Warning in `rInfJack()`:
+      Sample size <=20, no calibration performed.
+      Warning in `sqrt()`:
+      NaNs produced
+
+---
+
+    Code
+      parsnip_int <- predict(lc_fit, new_data = tail(lending_club), type = "conf_int",
+      std_error = TRUE, level = 0.93)
+    Condition
+      Warning in `rInfJack()`:
+      Sample size <=20, no calibration performed.
+      Warning in `rInfJack()`:
+      Sample size <=20, no calibration performed.
+      Warning in `sqrt()`:
+      NaNs produced
+
 # argument checks for data dimensions
 
     Code

tests/testthat/_snaps/surv_reg.md

@@ -36,3 +36,17 @@
       Error in `if (object$engine == "liquidSVM") ...`:
       ! argument is of length zero
 
+# deprecation warning
+
+    Code
+      surv_reg()
+    Condition
+      Warning:
+      `surv_reg()` was deprecated in parsnip 0.1.6.
+      i Please use `survival_reg()` instead.
+    Output
+      Parametric Survival Regression Model Specification (regression)
+      
+      Computational engine: survival 
+      
+

tests/testthat/test-boost_tree_C5.0.R

@@ -140,13 +140,11 @@ test_that('argument checks for data dimensions', {
     set_engine("C5.0") %>%
     set_mode("classification")
 
-  expect_warning(
-    f_fit  <- spec %>% fit(species ~ ., data = penguins),
-    "1000 samples were requested"
+  expect_snapshot(
+    f_fit  <- spec %>% fit(species ~ ., data = penguins)
   )
-  expect_warning(
-    xy_fit <- spec %>% fit_xy(x = penguins[, -1], y = penguins$species),
-    "1000 samples were requested"
+  expect_snapshot(
+    xy_fit <- spec %>% fit_xy(x = penguins[, -1], y = penguins$species)
   )
 
   expect_equal(extract_fit_engine(f_fit)$control$minCases,  nrow(penguins))

tests/testthat/test-boost_tree_xgboost.R

@@ -339,12 +339,11 @@ test_that('early stopping', {
       fit(mpg ~ ., data = mtcars[-(1:4), ])
   )
 
-  expect_warning(
+  expect_snapshot(
     reg_fit <-
       boost_tree(trees = 20, stop_iter = 30, mode = "regression") %>%
       set_engine("xgboost", validation = .1) %>%
-      fit(mpg ~ ., data = mtcars[-(1:4), ]),
-    regex = "`early_stop` was reduced to 19"
+      fit(mpg ~ ., data = mtcars[-(1:4), ])
   )
   expect_snapshot(
     error = TRUE,
@@ -483,13 +482,11 @@ test_that('argument checks for data dimensions', {
   penguins_dummy <- model.matrix(species ~ ., data = penguins)
   penguins_dummy <- as.data.frame(penguins_dummy[, -1])
 
-  expect_warning(
-    f_fit  <- spec %>% fit(species ~ ., data = penguins, control = ctrl),
-    "1000 samples were requested"
+  expect_snapshot(
+    f_fit  <- spec %>% fit(species ~ ., data = penguins, control = ctrl)
   )
-  expect_warning(
-    xy_fit <- spec %>% fit_xy(x = penguins_dummy, y = penguins$species, control = ctrl),
-    "1000 samples were requested"
+  expect_snapshot(
+    xy_fit <- spec %>% fit_xy(x = penguins_dummy, y = penguins$species, control = ctrl)
   )
   expect_equal(extract_fit_engine(f_fit)$params$colsample_bynode, 1)
   expect_equal(extract_fit_engine(f_fit)$params$min_child_weight, nrow(penguins))

tests/testthat/test-convert_data.R

@@ -330,7 +330,7 @@ test_that("numeric x and numeric multivariate y", {
 })
 
 test_that("numeric x and factor y", {
-  expect_warning(
+  expect_snapshot(
     expected <-
       glm(class ~ ., data = hpc, x = TRUE, y = TRUE, family = binomial())
   )

tests/testthat/test-failed_models.R

@@ -25,13 +25,13 @@ test_that('numeric model', {
     set_engine("lm") %>%
     fit(compounds ~ ., data = hpc_bad, control = ctrl)
 
-  expect_warning(num_res <- predict(lm_mod, hpc_bad[1:11, -1]))
+  expect_snapshot(num_res <- predict(lm_mod, hpc_bad[1:11, -1]))
   expect_equal(num_res, NULL)
 
-  expect_warning(ci_res <- predict(lm_mod, hpc_bad[1:11, -1], type = "conf_int"))
+  expect_snapshot(ci_res <- predict(lm_mod, hpc_bad[1:11, -1], type = "conf_int"))
   expect_equal(ci_res, NULL)
 
-  expect_warning(pi_res <- predict(lm_mod, hpc_bad[1:11, -1], type = "pred_int"))
+  expect_snapshot(pi_res <- predict(lm_mod, hpc_bad[1:11, -1], type = "pred_int"))
   expect_equal(pi_res, NULL)
 
 })
@@ -44,19 +44,19 @@ test_that('classification model', {
     set_engine("glm") %>%
     fit(Class ~ log(funded_amnt) + int_rate + big_num, data = lending_club, control = ctrl)
 
-  expect_warning(
+  expect_snapshot(
     cls_res <-
       predict(log_reg, lending_club %>%  dplyr::slice(1:7) %>% dplyr::select(-Class))
   )
   expect_equal(cls_res, NULL)
 
-  expect_warning(
+  expect_snapshot(
     prb_res <-
       predict(log_reg, lending_club %>%  dplyr::slice(1:7) %>% dplyr::select(-Class), type = "prob")
   )
   expect_equal(prb_res, NULL)
 
-  expect_warning(
+  expect_snapshot(
     ci_res <-
       predict(log_reg, lending_club %>%  dplyr::slice(1:7) %>% dplyr::select(-Class), type = "conf_int")
   )

tests/testthat/test-linear_reg.R

@@ -327,7 +327,7 @@ test_that('lm can handle rankdeficient predictions', {
     x4 = c(0,0,2,3)
   )
 
-  expect_warning(
+  expect_snapshot(
     preds <- linear_reg() %>%
       fit(y ~ ., data = data) %>%
       predict(new_data = data2)

tests/testthat/test-mlp.R

@@ -11,7 +11,7 @@ test_that('updating', {
 test_that('bad input', {
   expect_snapshot(error = TRUE, mlp(mode = "time series"))
   expect_snapshot(error = TRUE, translate(mlp(mode = "classification") %>% set_engine("wat?")))
-  expect_warning(translate(mlp(mode = "regression") %>% set_engine("nnet", formula = y ~ x)))
+  expect_snapshot(translate(mlp(mode = "regression") %>% set_engine("nnet", formula = y ~ x)))
   expect_snapshot(error = TRUE, translate(mlp(mode = "classification", x = x, y = y) %>% set_engine("keras")))
   expect_snapshot(error = TRUE, translate(mlp(mode = "regression", formula = y ~ x) %>% set_engine()))
 })

tests/testthat/test-multinom_reg.R

@@ -13,7 +13,7 @@ test_that('bad input', {
   expect_snapshot(error = TRUE, multinom_reg(mode = "regression"))
   expect_snapshot(error = TRUE, translate(multinom_reg(penalty = 0.1) %>% set_engine("wat?")))
   expect_snapshot(error = TRUE, multinom_reg(penalty = 0.1) %>% set_engine())
-  expect_warning(translate(multinom_reg(penalty = 0.1) %>% set_engine("glmnet", x = hpc[,1:3], y = hpc$class)))
+  expect_snapshot(translate(multinom_reg(penalty = 0.1) %>% set_engine("glmnet", x = hpc[,1:3], y = hpc$class)))
 })
 
 test_that('check_args() works', {