refactor sparevctrs functions out

Author: EmilHvitfeldt

R/convert_data.R

@@ -374,16 +374,21 @@ maybe_matrix <- function(x) {
                         "converted to numeric matrix: {non_num_cols}.")
       rlang::abort(msg)
     }
-    if (any(vapply(x, sparsevctrs::is_sparse_vector, logical(1)))) {
-      x <- sparsevctrs::coerce_to_sparse_matrix(x)
-    } else {
-      x <- as.matrix(x)
-    }
+    x <- maybe_sparse_matrix(x)
   }
   # leave alone if matrix or sparse matrix
   x
 }
 
+maybe_sparse_matrix <- function(x) {
+  if (any(vapply(x, sparsevctrs::is_sparse_vector, logical(1)))) {
+    res <- sparsevctrs::coerce_to_sparse_matrix(x)
+  } else {
+    res <- as.matrix(x)
+  }
+  res
+}
+
 #' @rdname maybe_matrix
 #' @export
 maybe_data_frame <- function(x) {

R/fit.R

@@ -275,17 +275,7 @@ fit_xy.model_spec <-
       }
     }
 
-    if (methods::is(x, "sparseMatrix")) {
-      if (allow_sparse(object)) {
-        x <- sparsevctrs::coerce_to_sparse_data_frame(x)
-      } else {
-        cli::cli_warn(c(
-          "!" = "{.arg x} is a sparse matrix, but model doesn't accept that.",
-          "i" = "Converted {.arg x} to data.frame."
-        ))
-        x <- as.data.frame(x)
-      }
-    }
+    x <- to_sparse_data_frame(x, object)
 
     cl <- match.call(expand.dots = TRUE)
     eval_env <- rlang::env()

R/sparsevctrs.R

@@ -0,0 +1,14 @@
+to_sparse_data_frame <- function(x, object) {
+  if (methods::is(x, "sparseMatrix")) {
+    if (allow_sparse(object)) {
+      x <- sparsevctrs::coerce_to_sparse_data_frame(x)
+    } else {
+      cli::cli_warn(c(
+        "!" = "{.arg x} is a sparse matrix, but model doesn't accept that.",
+        "i" = "Converted {.arg x} to data.frame."
+      ))
+      x <- as.data.frame(x)
+    }
+  }
+  x
+}