refactor out materialize_sparse_tibble()

Author: EmilHvitfeldt

R/fit.R

@@ -174,18 +174,8 @@ fit.model_spec <-
     eval_env$formula <- formula
     eval_env$weights <- wts
 
-    if ((!allow_sparse(object)) && is_sparse_tibble(data)) {
-      cli::cli_warn(
-        "{.arg data} is a sparse tibble, but {.fn {class(object)[1]}} with
-        engine {.code {object$engine}} doesn't accept that. Converting to 
-        non-sparse."
-      )
-      for (i in seq_along(ncol(data))) {
-        # materialize with []
-        data[[i]] <- data[[i]][]
-      }
-    }
-
+    data <- materialize_sparse_tibble(data, object, "data")
+    
     fit_interface <-
       check_interface(eval_env$formula, eval_env$data, cl, object)
 

R/sparsevctrs.R

@@ -8,21 +8,26 @@ to_sparse_data_frame <- function(x, object) {
        engine {.code {object$engine}} doesn't accept that.")
     }
   } else if (is.data.frame(x)) {
-    if ((!allow_sparse(object)) && is_sparse_tibble(x)) {
-      cli::cli_warn(
-        "{.arg x} is a sparse tibble, but {.fn {class(object)[1]}} with
-        engine {.code {object$engine}} doesn't accept that. Converting to 
-        non-sparse."
-      )
-      for (i in seq_along(ncol(x))) {
-        # materialize with []
-        x[[i]] <- x[[i]][]
-      }
-    }
+    x <- materialize_sparse_tibble(x, object, "x")
   }
   x
 }
 
 is_sparse_tibble <- function(x) {
   any(vapply(x, sparsevctrs::is_sparse_vector, logical(1)))
-}
+}
+
+materialize_sparse_tibble <- function(x, object, input) {
+  if ((!allow_sparse(object)) && is_sparse_tibble(x)) {
+    cli::cli_warn(
+      "{.arg {input}} is a sparse tibble, but {.fn {class(object)[1]}} with
+      engine {.code {object$engine}} doesn't accept that. Converting to 
+      non-sparse."
+    )
+    for (i in seq_along(ncol(x))) {
+      # materialize with []
+      x[[i]] <- x[[i]][]
+    }
+  }
+  x
+}