changes for sparse matrices with ranger

Author: topepo

R/boost_tree.R

@@ -375,7 +375,7 @@ xgb_train <- function(
 #' @importFrom stats binomial
 xgb_pred <- function(object, newdata, ...) {
   if (!inherits(newdata, "xgb.DMatrix")) {
-    newdata <- as_matrix(newdata)
+    newdata <- maybe_matrix(newdata)
     newdata <- xgboost::xgb.DMatrix(data = newdata, missing = NA)
   }
 

R/rand_forest_data.R

@@ -120,8 +120,8 @@ set_fit(
   eng = "ranger",
   mode = "classification",
   value = list(
-    interface = "formula",
-    protect = c("formula", "data", "case.weights"),
+    interface = "data.frame",
+    protect = c("x", "y", "case.weights"),
     func = c(pkg = "ranger", fun = "ranger"),
     defaults =
       list(
@@ -148,8 +148,8 @@ set_fit(
   eng = "ranger",
   mode = "regression",
   value = list(
-    interface = "formula",
-    protect = c("formula", "data", "case.weights"),
+    interface = "data.frame",
+    protect = c("x", "y", "case.weights"),
     func = c(pkg = "ranger", fun = "ranger"),
     defaults =
       list(

man/as_matrix.Rd

@@ -16,8 +16,8 @@ test_that('primary arguments', {
   mtry_spark <- translate(mtry %>% set_engine("spark"))
   expect_equal(mtry_ranger$method$fit$args,
                list(
-                 formula = expr(missing_arg()),
-                 data = expr(missing_arg()),
+                 x = expr(missing_arg()),
+                 y = expr(missing_arg()),
                  case.weights = expr(missing_arg()),
                  mtry = new_empty_quosure(4),
                  num.threads = 1,
@@ -47,8 +47,8 @@ test_that('primary arguments', {
   trees_spark <- translate(trees %>% set_engine("spark"))
   expect_equal(trees_ranger$method$fit$args,
                list(
-                 formula = expr(missing_arg()),
-                 data = expr(missing_arg()),
+                 x = expr(missing_arg()),
+                 y = expr(missing_arg()),
                  case.weights = expr(missing_arg()),
                  num.trees = new_empty_quosure(1000),
                  num.threads = 1,
@@ -80,8 +80,8 @@ test_that('primary arguments', {
   min_n_spark <- translate(min_n %>% set_engine("spark"))
   expect_equal(min_n_ranger$method$fit$args,
                list(
-                 formula = expr(missing_arg()),
-                 data = expr(missing_arg()),
+                 x = expr(missing_arg()),
+                 y = expr(missing_arg()),
                  case.weights = expr(missing_arg()),
                  min.node.size = new_empty_quosure(5),
                  num.threads = 1,
@@ -112,8 +112,8 @@ test_that('primary arguments', {
   mtry_v_spark <- translate(mtry_v %>% set_engine("spark"))
   expect_equal(mtry_v_ranger$method$fit$args,
                list(
-                 formula = expr(missing_arg()),
-                 data = expr(missing_arg()),
+                 x = expr(missing_arg()),
+                 y = expr(missing_arg()),
                  case.weights = expr(missing_arg()),
                  mtry = new_empty_quosure(varying()),
                  num.threads = 1,
@@ -145,8 +145,8 @@ test_that('primary arguments', {
   trees_v_spark <- translate(trees_v %>% set_engine("spark"))
   expect_equal(trees_v_ranger$method$fit$args,
                list(
-                 formula = expr(missing_arg()),
-                 data = expr(missing_arg()),
+                 x = expr(missing_arg()),
+                 y = expr(missing_arg()),
                  case.weights = expr(missing_arg()),
                  num.trees = new_empty_quosure(varying()),
                  num.threads = 1,
@@ -177,8 +177,8 @@ test_that('primary arguments', {
   min_n_v_spark <- translate(min_n_v %>% set_engine("spark"))
   expect_equal(min_n_v_ranger$method$fit$args,
                list(
-                 formula = expr(missing_arg()),
-                 data = expr(missing_arg()),
+                 x = expr(missing_arg()),
+                 y = expr(missing_arg()),
                  case.weights = expr(missing_arg()),
                  min.node.size = new_empty_quosure(varying()),
                  num.threads = 1,
@@ -210,8 +210,8 @@ test_that('engine arguments', {
   ranger_imp <- rand_forest(mode = "classification")
   expect_equal(translate(ranger_imp %>% set_engine("ranger", importance = "impurity"))$method$fit$args,
                list(
-                 formula = expr(missing_arg()),
-                 data = expr(missing_arg()),
+                 x = expr(missing_arg()),
+                 y = expr(missing_arg()),
                  case.weights = expr(missing_arg()),
                  importance = new_empty_quosure("impurity"),
                  num.threads = 1,
@@ -246,8 +246,8 @@ test_that('engine arguments', {
     translate(ranger_samp_frac %>%
                 set_engine("ranger", sample.fraction = varying()))$method$fit$args,
     list(
-      formula = expr(missing_arg()),
-      data = expr(missing_arg()),
+      x = expr(missing_arg()),
+      y = expr(missing_arg()),
       case.weights = expr(missing_arg()),
       sample.fraction = new_empty_quosure(varying()),
       num.threads = 1,

man/rand_forest.Rd

@@ -439,3 +439,29 @@ test_that('ranger classification intervals', {
 
 })
 
+
+
+test_that('ranger and sparse matrices', {
+  skip_if_not_installed("ranger")
+
+  mtcar_x <- mtcars[, -1]
+  mtcar_mat <- as.matrix(mtcar_x)
+  mtcar_smat <- Matrix::Matrix(mtcar_mat, sparse = TRUE)
+
+  rf_spec <-
+    rand_forest(trees = 10) %>%
+    set_engine("ranger", seed = 2) %>%
+    set_mode("regression")
+
+  set.seed(1)
+  from_df <- rf_spec %>% fit_xy(mtcar_x, mtcars$mpg)
+  set.seed(1)
+  from_mat <- rf_spec %>% fit_xy(mtcar_mat, mtcars$mpg)
+  set.seed(1)
+  from_sparse <- rf_spec %>% fit_xy(mtcar_smat, mtcars$mpg)
+
+  expect_equal(from_df$fit, from_mat$fit)
+  expect_equal(from_df$fit, from_sparse$fit)
+
+})
+