Stricter sparsevctrs tests

NEWS.md

@@ -2,7 +2,7 @@
 
 * `fit_xy()` can now take dgCMatrix input for `x` argument (#1121).
 
-* `fit()` and `fit_xy()` can now take sparse tibbles as data values (#1165).
+* `fit_xy()` can now take sparse tibbles as data values (#1165).
 
 * `predict()` can now take dgCMatrix and sparse tibble input for `new_data` argument, and error informatively when model doesn't support it (#1167).
 

R/convert_data.R

@@ -48,6 +48,13 @@
     )
   }
 
+  if (is_sparse_tibble(data)) {
+    cli::cli_abort(
+      "Sparse data cannot be used with formula interface. Please use 
+      {.fn fit_xy} instead."
+    )
+  }
+
   if (remove_intercept) {
     data <- data[, colnames(data) != "(Intercept)", drop = FALSE]
   }

R/predict.R

@@ -470,6 +470,10 @@ prepare_data <- function(object, new_data) {
   if (allow_sparse(object) && inherits(new_data, "dgCMatrix")) {
     return(new_data)
   }
+  if (allow_sparse(object) && is_sparse_tibble(new_data)) {
+    new_data <- sparsevctrs::coerce_to_sparse_matrix(new_data)
+    return(new_data)
+  }
 
   fit_interface <- object$spec$method$fit$interface
   switch(

tests/testthat/_snaps/sparsevctrs.md

@@ -1,5 +1,13 @@
 # sparse tibble can be passed to `fit()
 
+    Code
+      lm_fit <- fit(spec, avg_price_per_room ~ ., data = hotel_data)
+    Condition
+      Error in `.convert_form_to_xy_fit()`:
+      ! Sparse data cannot be used with formula interface. Please use `fit_xy()` instead.
+
+---
+
     Code
       lm_fit <- fit(spec, avg_price_per_room ~ ., data = hotel_data[1:100, ])
     Condition
@@ -8,6 +16,14 @@
 
 # sparse matrix can be passed to `fit()
 
+    Code
+      lm_fit <- fit(spec, avg_price_per_room ~ ., data = hotel_data)
+    Condition
+      Error in `.convert_form_to_xy_fit()`:
+      ! Sparse data cannot be used with formula interface. Please use `fit_xy()` instead.
+
+---
+
     Code
       lm_fit <- fit(spec, avg_price_per_room ~ ., data = hotel_data[1:100, ])
     Condition
@@ -46,6 +62,14 @@
       Error in `predict()`:
       ! `x` is a sparse matrix, but `linear_reg()` with engine "lm" doesn't accept that.
 
+# sparse data work with xgboost engine
+
+    Code
+      tree_fit <- fit(spec, avg_price_per_room ~ ., data = hotel_data)
+    Condition
+      Error in `.convert_form_to_xy_fit()`:
+      ! Sparse data cannot be used with formula interface. Please use `fit_xy()` instead.
+
 # to_sparse_data_frame() is used correctly
 
     Code

tests/testthat/test-sparsevctrs.R

@@ -1,39 +1,47 @@
 test_that("sparse tibble can be passed to `fit()", {
   skip_if_not_installed("xgboost")
+  withr::local_options("sparsevctrs.verbose_materialize" = 3)
 
   hotel_data <- sparse_hotel_rates()
   hotel_data <- sparsevctrs::coerce_to_sparse_tibble(hotel_data)
 
   spec <- boost_tree() %>%
     set_mode("regression") %>%
     set_engine("xgboost")
-
-  expect_no_error(
+
+  expect_snapshot(
+    error = TRUE,
     lm_fit <- fit(spec, avg_price_per_room ~ ., data = hotel_data)
   )
 
   spec <- linear_reg() %>%
     set_mode("regression") %>%
     set_engine("lm")
 
+  withr::local_options("sparsevctrs.verbose_materialize" = NULL)
+
   expect_snapshot(
     lm_fit <- fit(spec, avg_price_per_room ~ ., data = hotel_data[1:100, ])
   )
 })
 
 test_that("sparse matrix can be passed to `fit()", {
   skip_if_not_installed("xgboost")
-
+  withr::local_options("sparsevctrs.verbose_materialize" = 3)
+
   hotel_data <- sparse_hotel_rates()
-
+  
   spec <- boost_tree() %>%
     set_mode("regression") %>%
     set_engine("xgboost")
 
-  expect_no_error(
+  expect_snapshot(
+    error = TRUE,
     lm_fit <- fit(spec, avg_price_per_room ~ ., data = hotel_data)
   )
 
+  withr::local_options("sparsevctrs.verbose_materialize" = NULL)
+
   spec <- linear_reg() %>%
     set_mode("regression") %>%
     set_engine("lm")
@@ -45,9 +53,14 @@ test_that("sparse matrix can be passed to `fit()", {
 
 test_that("sparse tibble can be passed to `fit_xy()", {
   skip_if_not_installed("xgboost")
-
+  
   hotel_data <- sparse_hotel_rates()
   hotel_data <- sparsevctrs::coerce_to_sparse_tibble(hotel_data)
+
+  # materialize outcome
+  hotel_data$avg_price_per_room <- hotel_data$avg_price_per_room[]
+
+  withr::local_options("sparsevctrs.verbose_materialize" = 3)
 
   spec <- boost_tree() %>%
     set_mode("regression") %>%
@@ -57,6 +70,8 @@ test_that("sparse tibble can be passed to `fit_xy()", {
     lm_fit <- fit_xy(spec, x = hotel_data[, -1], y = hotel_data[, 1])
   )
 
+  withr::local_options("sparsevctrs.verbose_materialize" = NULL)
+
   spec <- linear_reg() %>%
     set_mode("regression") %>%
     set_engine("lm")
@@ -68,6 +83,7 @@ test_that("sparse tibble can be passed to `fit_xy()", {
 
 test_that("sparse matrices can be passed to `fit_xy()", {
   skip_if_not_installed("xgboost")
+  withr::local_options("sparsevctrs.verbose_materialize" = 3)
 
   hotel_data <- sparse_hotel_rates()
 
@@ -94,6 +110,11 @@ test_that("sparse tibble can be passed to `predict()", {
 
   hotel_data <- sparse_hotel_rates()
   hotel_data <- sparsevctrs::coerce_to_sparse_tibble(hotel_data)
+
+  # materialize outcome
+  hotel_data$avg_price_per_room <- hotel_data$avg_price_per_room[]
+
+  withr::local_options("sparsevctrs.verbose_materialize" = 3)
 
   spec <- rand_forest(trees = 10) %>%
     set_mode("regression") %>%
@@ -105,6 +126,8 @@ test_that("sparse tibble can be passed to `predict()", {
     predict(tree_fit, hotel_data)
   )
 
+  withr::local_options("sparsevctrs.verbose_materialize" = NULL)
+
   spec <- linear_reg() %>%
     set_mode("regression") %>%
     set_engine("lm")
@@ -122,6 +145,7 @@ test_that("sparse tibble can be passed to `predict()", {
 
 test_that("sparse matrices can be passed to `predict()", {
   skip_if_not_installed("ranger")
+  withr::local_options("sparsevctrs.verbose_materialize" = 3)
 
   hotel_data <- sparse_hotel_rates()
 
@@ -151,6 +175,7 @@ test_that("sparse matrices can be passed to `predict()", {
 
 test_that("sparse data work with xgboost engine", {
   skip_if_not_installed("xgboost")
+  withr::local_options("sparsevctrs.verbose_materialize" = 3)
 
   spec <- boost_tree() %>%
     set_mode("regression") %>%
@@ -161,22 +186,28 @@ test_that("sparse data work with xgboost engine", {
   expect_no_error(
     tree_fit <- fit_xy(spec, x = hotel_data[, -1], y = hotel_data[, 1])
    )
-
+   
    expect_no_error(
      predict(tree_fit, hotel_data)
    )
 
   hotel_data <- sparsevctrs::coerce_to_sparse_tibble(hotel_data)
 
 
-  expect_no_error(
+  expect_snapshot(
+    error = TRUE,
     tree_fit <- fit(spec, avg_price_per_room ~ ., data = hotel_data)
   )
 
   expect_no_error(
     predict(tree_fit, hotel_data)
   )
 
+  # materialize outcome
+  withr::local_options("sparsevctrs.verbose_materialize" = NULL)
+  hotel_data$avg_price_per_room <- hotel_data$avg_price_per_room[]
+  withr::local_options("sparsevctrs.verbose_materialize" = 3)
+
   expect_no_error(
    tree_fit <- fit_xy(spec, x = hotel_data[, -1], y = hotel_data[, 1])
   )
@@ -188,6 +219,7 @@ test_that("sparse data work with xgboost engine", {
 
 test_that("to_sparse_data_frame() is used correctly", {
   skip_if_not_installed("xgboost")
+  withr::local_options("sparsevctrs.verbose_materialize" = 3)
 
   local_mocked_bindings(
     to_sparse_data_frame = function(x, object) {
@@ -228,6 +260,7 @@ test_that("to_sparse_data_frame() is used correctly", {
 
 test_that("maybe_sparse_matrix() is used correctly", {
   skip_if_not_installed("xgboost")
+  withr::local_options("sparsevctrs.verbose_materialize" = 3)
 
   local_mocked_bindings(
     maybe_sparse_matrix = function(x) {