glmnet multi_predict(): tighten tests for checks on prediction type

tests/testthat/_snaps/glmnet-linear.md

@@ -16,3 +16,11 @@
       * To try multiple values for total regularization, use the tune package.
       * To predict multiple penalties, use `multi_predict()`
 
+---
+
+    Code
+      linear_reg(penalty = 0.01) %>% set_engine("glmnet") %>% fit(mpg ~ ., data = mtcars) %>%
+        multi_predict(mtcars, type = "class")
+    Error <rlang_error>
+      For class predictions, the object should be a classification model.
+

tests/testthat/_snaps/glmnet-logistic.md

@@ -25,3 +25,12 @@
       * To try multiple values for total regularization, use the tune package.
       * To predict multiple penalties, use `multi_predict()`
 
+---
+
+    Code
+      logistic_reg(penalty = 0.01) %>% set_engine("glmnet") %>% fit(Class ~ log(
+        funded_amnt) + int_rate + term, data = lending_club) %>% multi_predict(
+        lending_club, type = "time")
+    Error <rlang_error>
+      For event time predictions, the object should be a censored regression.
+

tests/testthat/_snaps/glmnet-multinom.md

@@ -23,3 +23,11 @@
       * To try multiple values for total regularization, use the tune package.
       * To predict multiple penalties, use `multi_predict()`
 
+---
+
+    Code
+      multinom_reg(penalty = 0.01) %>% set_engine("glmnet") %>% fit(class ~ ., data = hpc_data) %>%
+        multi_predict(hpc_data, type = "numeric")
+    Error <rlang_error>
+      For numeric predictions, the object should be a regression model.
+

tests/testthat/test-glmnet-linear.R

@@ -162,8 +162,9 @@ test_that("glmnet multi_predict(): type numeric", {
   expect_true(has_multi_predict(xy_fit))
   expect_equal(multi_predict_args(xy_fit), "penalty")
 
-  f_pred <- multi_predict(f_fit, hpc, penalty = penalty_values)
-  xy_pred <- multi_predict(xy_fit, hpc_x, penalty = penalty_values)
+  f_pred <- multi_predict(f_fit, hpc, type = "numeric", penalty = penalty_values)
+  xy_pred <- multi_predict(xy_fit, hpc_x, type = "numeric",
+                           penalty = penalty_values)
   expect_equal(f_pred, xy_pred)
 
   f_pred_001 <- f_pred %>%
@@ -191,13 +192,35 @@ test_that("glmnet multi_predict(): type numeric", {
   )
 
   # single prediction
-  f_pred_1 <- multi_predict(f_fit, hpc[1, ], penalty = penalty_values)
-  xy_pred_1 <- multi_predict(xy_fit, hpc_x[1, , drop = FALSE], penalty = penalty_values)
+  f_pred_1 <- multi_predict(f_fit, hpc[1, ], type = "numeric",
+                            penalty = penalty_values)
+  xy_pred_1 <- multi_predict(xy_fit, hpc_x[1, , drop = FALSE], type = "numeric",
+                             penalty = penalty_values)
   expect_equal(f_pred_1, xy_pred_1)
   expect_equal(nrow(f_pred_1), 1)
   expect_equal(nrow(f_pred_1$.pred[[1]]), 2)
 })
 
+test_that("glmnet multi_predict(): type NULL", {
+  skip_if_not_installed("glmnet")
+  skip_if_not_installed("parsnip", minimum_version = "1.0.4.9002")
+
+  data("hpc_data", package = "modeldata", envir = rlang::current_env())
+  hpc <- hpc_data[1:150, c(2:5, 8)]
+
+  spec <- linear_reg(penalty = 0.1, mixture = 0.3) %>%
+    set_engine("glmnet", nlambda = 15)
+  f_fit <- fit(spec, input_fields ~ log(compounds) + class, data = hpc)
+
+  pred <- predict(f_fit, hpc[1:5,])
+  pred_numeric <- predict(f_fit, hpc[1:5,], type = "numeric")
+  expect_identical(pred, pred_numeric)
+
+  mpred <- multi_predict(f_fit, hpc[1:5,])
+  mpred_numeric <- multi_predict(f_fit, hpc[1:5,], type = "numeric")
+  expect_identical(mpred, mpred_numeric)
+})
+
 test_that('multi_predict() with default or single penalty value', {
   skip_if_not_installed("glmnet")
 
@@ -254,6 +277,13 @@ test_that('error traps', {
       set_engine("glmnet") %>%
       fit(mpg ~ ., data = mtcars[-(1:4), ])
   })
+  skip_if_not_installed("parsnip", minimum_version = "1.0.4.9003")
+  expect_snapshot(error = TRUE, {
+    linear_reg(penalty = 0.01) %>%
+      set_engine("glmnet") %>%
+      fit(mpg ~ ., data = mtcars) %>%
+      multi_predict(mtcars, type = "class")
+  })
 })
 
 test_that("base-R families: type numeric", {

tests/testthat/test-glmnet-logistic.R

@@ -200,7 +200,7 @@ test_that("glmnet multi_predict(): type class", {
   expect_equal(multi_predict_args(xy_fit), "penalty")
 
   f_pred <- multi_predict(f_fit, lending_club, penalty = penalty_values, type = "class")
-  xy_pred <- multi_predict(xy_fit, lending_club_x, penalty = penalty_values, type = "class") # FIXME make this work with just hpc instead of hpc_x?
+  xy_pred <- multi_predict(xy_fit, lending_club_x, penalty = penalty_values, type = "class")
   expect_equal(f_pred, xy_pred)
 
   f_pred_001 <- f_pred %>%
@@ -254,7 +254,7 @@ test_that("glmnet multi_predict(): type prob", {
   xy_fit <- fit_xy(lr_spec, x = lending_club_x, y = lending_club_y)
 
   f_pred <- multi_predict(f_fit, lending_club, penalty = penalty_values, type = "prob")
-  xy_pred <- multi_predict(xy_fit, lending_club_x, penalty = penalty_values, type = "prob") # FIXME make this work with just hpc instead of hpc_x?
+  xy_pred <- multi_predict(xy_fit, lending_club_x, penalty = penalty_values, type = "prob")
   expect_equal(f_pred, xy_pred)
 
   f_pred_001 <- f_pred %>%
@@ -291,6 +291,25 @@ test_that("glmnet multi_predict(): type prob", {
   expect_equal(nrow(f_pred_1$.pred[[1]]), 2)
 })
 
+test_that("glmnet multi_predict(): type NULL", {
+  skip_if_not_installed("glmnet")
+
+  data("lending_club", package = "modeldata", envir = rlang::current_env())
+  lending_club <- lending_club[1:200, ]
+
+  spec <- logistic_reg(penalty = 0.1, mixture = 0.3) %>%
+    set_engine("glmnet", nlambda = 15)
+  f_fit <- fit(spec, Class ~ log(funded_amnt) + int_rate + term, data = lending_club)
+
+  pred <- predict(f_fit, lending_club[1:5,])
+  pred_class <- predict(f_fit, lending_club[1:5,], type = "class")
+  expect_identical(pred, pred_class)
+
+  mpred <- multi_predict(f_fit, lending_club[1:5,])
+  mpred_class <- multi_predict(f_fit, lending_club[1:5,], type = "class")
+  expect_identical(mpred, mpred_class)
+})
+
 test_that('multi_predict() with default or single penalty value', {
 
   skip_if_not_installed("glmnet")
@@ -372,6 +391,14 @@ test_that('error traps', {
       fit(Class ~ log(funded_amnt) + int_rate + term,
           data = lending_club)
   })
+  skip_if_not_installed("parsnip", minimum_version = "1.0.4.9003")
+  expect_snapshot(error = TRUE, {
+    logistic_reg(penalty = 0.01) %>%
+      set_engine("glmnet") %>%
+      fit(Class ~ log(funded_amnt) + int_rate + term,
+          data = lending_club) %>%
+      multi_predict(lending_club, type = "time")
+  })
 })
 
 test_that("base-R families: type class", {

tests/testthat/test-glmnet-multinom.R

@@ -324,6 +324,24 @@ test_that("glmnet multi_predict(): type prob", {
   expect_equal(nrow(f_pred_1$.pred[[1]]), 2)
 })
 
+test_that("glmnet multi_predict(): type NULL", {
+  skip_if_not_installed("glmnet")
+
+  data("hpc_data", package = "modeldata", envir = rlang::current_env())
+
+  spec <- multinom_reg(penalty = 0.1) %>% set_engine("glmnet")
+  f_fit <- fit(spec, class ~ protocol + log(compounds) + input_fields,
+               data = hpc_data)
+
+  pred <- predict(f_fit, hpc_data[1:5,])
+  pred_class <- predict(f_fit, hpc_data[1:5,], type = "class")
+  expect_identical(pred, pred_class)
+
+  mpred <- multi_predict(f_fit, hpc_data[1:5,])
+  mpred_class <- multi_predict(f_fit, hpc_data[1:5,], type = "class")
+  expect_identical(mpred, mpred_class)
+})
+
 test_that("multi_predict() with default or single penalty value", {
 
   skip_if_not_installed("glmnet")
@@ -393,4 +411,11 @@ test_that('error traps', {
       set_engine("glmnet") %>%
       fit(class ~ ., data = hpc_data)
   })
+  skip_if_not_installed("parsnip", minimum_version = "1.0.4.9003")
+  expect_snapshot(error = TRUE, {
+    multinom_reg(penalty = 0.01) %>%
+      set_engine("glmnet") %>%
+      fit(class ~ ., data = hpc_data) %>%
+      multi_predict(hpc_data, type = "numeric")
+  })
 })