re-enable some skipped tests (#1093)

* fit a glmnet model with a real penalty

* rework test

* skips no longer needed

* add a few installs

* Apply suggestions from code review

Co-authored-by: github-actions[bot] <41898282+github-actions[bot]@users.noreply.github.com>

* air format

* Apply suggestions from code review

Co-authored-by: github-actions[bot] <41898282+github-actions[bot]@users.noreply.github.com>

* Apply suggestions from code review

Co-authored-by: github-actions[bot] <41898282+github-actions[bot]@users.noreply.github.com>

---------

Co-authored-by: github-actions[bot] <41898282+github-actions[bot]@users.noreply.github.com>

Author: topepo

.github/workflows/R-CMD-check.yaml

@@ -56,6 +56,15 @@ jobs:
           extra-packages: any::rcmdcheck
           needs: check
 
+     - name: Try to install a few packages for testing
+        run: |
+          # from most dependency-heavy to least
+          try(pak::pkg_install(c(
+            "randomForest",
+            "glmnet"
+          )))
+        shell: Rscript {0}
+
       - uses: r-lib/actions/check-r-package@v2
         with:
           upload-snapshots: true

tests/testthat/test-bayes.R

@@ -283,7 +283,6 @@ test_that("tune model and recipe (multi-predict)", {
 # ------------------------------------------------------------------------------
 
 test_that("tune recipe only - failure in recipe is caught elegantly", {
-  skip("test is not implemented for tune_bayes()")
   skip_if_not_installed("splines2")
 
   # With tune_grid() this tests for NA values in the grid.
@@ -301,36 +300,47 @@ test_that("tune recipe only - failure in recipe is caught elegantly", {
   # NA values not allowed in recipe
   cars_grid <- tibble(deg_free = c(3, NA_real_, 4))
 
-  # ask for predictions and extractions
-  control <- control_bayes(
-    save_pred = TRUE,
-    extract = function(x) 1L
-  )
-
   suppressMessages({
-    cars_res <- tune_bayes(
+    cars_init_res <- tune_grid(
       model,
       preprocessor = rec,
       resamples = data_folds,
-      control = control
+      grid = cars_grid
     )
   })
 
-  notes <- cars_res$.notes
-  note <- notes[[1]]$note
+  suppressMessages({
+    set.seed(283) #<- chosen to not generate faiures
+    cars_bayes_res <- tune_bayes(
+      model,
+      preprocessor = rec,
+      resamples = data_folds,
+      initial = cars_init_res,
+      iter = 2
+    )
+  })
 
-  extract <- cars_res$.extracts[[1]]
+  exp_failures <- nrow(data_folds) * sum(!complete.cases(cars_grid))
+  obs_init_failures <- collect_notes(cars_init_res) |>
+    filter(type == "error") |>
+    nrow()
+  obs_failures <- collect_notes(cars_bayes_res) |>
+    filter(type == "error") |>
+    nrow()
 
-  predictions <- cars_res$.predictions[[1]]
-  used_deg_free <- sort(unique(predictions$deg_free))
+  exp_init_grid_res <-
+    cars_grid |> tidyr::drop_na() |> distinct(deg_free) |> nrow()
 
-  expect_length(notes, 2L)
+  expect_equal(obs_init_failures, obs_failures)
+  expect_equal(obs_failures, exp_failures)
 
-  # failing rows are not in the output
-  expect_equal(nrow(extract), 2L)
-  expect_equal(extract$deg_free, c(3, 4))
+  all_notes <- collect_notes(cars_bayes_res)
+  expect_equal(nrow(all_notes), 11L)
 
-  expect_equal(used_deg_free, c(3, 4))
+  expect_equal(
+    collect_metrics(cars_bayes_res) |> distinct(deg_free) |> nrow(),
+    exp_init_grid_res + 2
+  )
 })
 
 test_that("tune model only - failure in recipe is caught elegantly", {
@@ -397,38 +407,51 @@ test_that("tune model and recipe - failure in recipe is caught elegantly", {
     recipes::step_spline_b(disp, deg_free = tune())
 
   # NA values not allowed in recipe
-  cars_grid <- tibble(deg_free = c(NA_real_, 10L), cost = 0.01)
+  cars_grid <- tibble(
+    deg_free = c(3L, NA_real_, 10L),
+    cost = c(0.1, 0.01, 0.001)
+  )
 
   suppressMessages({
-    cars_res <- tune_bayes(
+    cars_init_res <- tune_grid(
       svm_mod,
       preprocessor = rec,
       resamples = data_folds,
-      control = control_bayes(
-        extract = function(x) {
-          1
-        },
-        save_pred = TRUE
-      )
+      grid = cars_grid
+    )
+  })
+
+  suppressMessages({
+    set.seed(283) #<- chosen to not generate faiures
+    cars_bayes_res <- tune_bayes(
+      svm_mod,
+      preprocessor = rec,
+      resamples = data_folds,
+      initial = cars_init_res,
+      iter = 2
     )
   })
 
-  notes <- cars_res$.notes
-  note <- notes[[1]]$note
+  exp_failures <- nrow(data_folds) * sum(!complete.cases(cars_grid))
+  obs_init_failures <- collect_notes(cars_init_res) |>
+    filter(type == "error") |>
+    nrow()
+  obs_failures <- collect_notes(cars_bayes_res) |>
+    filter(type == "error") |>
+    nrow()
 
-  extract <- cars_res$.extracts[[1]]
-  prediction <- cars_res$.predictions[[1]]
+  exp_init_grid_res <-
+    cars_grid |> tidyr::drop_na() |> distinct(deg_free, cost) |> nrow()
 
-  expect_length(notes, 2L)
+  expect_equal(obs_init_failures, obs_failures)
+  expect_equal(obs_failures, exp_failures)
 
-  # recipe failed half of the time, only 1 model passed
-  expect_equal(nrow(extract), 1L)
-  expect_equal(extract$deg_free, 10L)
-  expect_equal(extract$cost, 0.01)
+  all_notes <- collect_notes(cars_bayes_res)
+  expect_equal(nrow(all_notes), 6L)
 
   expect_equal(
-    unique(prediction[, c("deg_free", "cost")]),
-    tibble(deg_free = 10, cost = 0.01)
+    collect_metrics(cars_bayes_res) |> distinct(deg_free, cost) |> nrow(),
+    exp_init_grid_res + 2
   )
 })
 

tests/testthat/test-last-fit.R

@@ -129,7 +129,6 @@ test_that("argument order gives errors for recipe/formula", {
 
 test_that("same results of last_fit() and fit() (#300)", {
   skip_if_not_installed("randomForest")
-  skip("determine how to handle this with parallel seeds; maybe opt out?")
 
   rf <- parsnip::rand_forest(mtry = 2, trees = 5) |>
     parsnip::set_engine("randomForest") |>
@@ -250,7 +249,6 @@ test_that("can use `last_fit()` with a workflow - postprocessor (requires traini
   skip_if_not_installed("mgcv")
   skip_if_not_installed("tailor", minimum_version = "0.0.0.9002")
   skip_if_not_installed("probably")
-  skip("work on how to make internal_calibration_split reproducible")
 
   y <- seq(0, 7, .001)
   dat <- data.frame(y = y, x = y + (y - 3)^2)

tests/testthat/test-loop-over-all-stages-helpers-predict-all-types.R

@@ -1056,8 +1056,6 @@ test_that("predict censored regression - submodels - no calibration", {
   skip_if_not_installed("survival")
   skip_if_not_installed("glmnet")
 
-  skip("not working")
-
   library(censored)
 
   cens <- make_post_data(mode = "censored")
@@ -1068,7 +1066,7 @@ test_that("predict censored regression - submodels - no calibration", {
   glmn_cens <- proportional_hazards(penalty = tune()) |> set_engine("glmnet")
 
   wflow <- workflow(pca_rec, glmn_cens)
-  wflow_fit <- fit(wflow, cens$data)
+
   grd <-
     wflow |>
     extract_parameter_set_dials() |>
@@ -1089,6 +1087,11 @@ test_that("predict censored regression - submodels - no calibration", {
 
   ctrl <- tune::control_grid()
 
+  wflow_fit <-
+    wflow |>
+    finalize_workflow(grd[1, ]) |>
+    fit(cens$data)
+
   # ----------------------------------------------------------------------------
   # static metrics
 
@@ -1105,10 +1108,6 @@ test_that("predict censored regression - submodels - no calibration", {
   static_stc <- tune:::update_static(static_stc, data_1)
   static_stc$y_name <- "outcome"
 
-  # TODO error
-  # Error in lambda[1] - s : non-numeric argument to binary operator
-  # Called from: lambda.interp(lambda, s)
-
   res_stc <- tune:::predict_all_types(
     wflow_fit,
     static_stc,