prefit xgboost model in xrf_fit(), allow early stopping

DESCRIPTION

@@ -17,7 +17,7 @@ License: MIT + file LICENSE
 URL: https://github.com/tidymodels/rules, https://rules.tidymodels.org/
 BugReports: https://github.com/tidymodels/rules/issues
 Depends:
-    parsnip (>= 0.2.0),
+    parsnip (>= 0.2.1.9003),
     R (>= 3.4)
 Imports: 
     dials (>= 0.1.1.9001),
@@ -40,7 +40,8 @@ Suggests:
     testthat (>= 3.0.0),
     xrf (>= 0.2.0)
 Remotes:
-    tidymodels/dials
+    tidymodels/dials,
+    tidymodels/parsnip@rule-fit-stop-iter
 Config/Needs/website: 
     tidyr, 
     tidyverse/tidytemplate, 

NEWS.md

@@ -6,8 +6,11 @@
 
 * The `mtry_prop` parameter was moved to the dials package and is now re-exported here for backward compatibility.
 
-* A bug was fixed related to `multi_predict()` with C5.0 rule-based models (#49)
+* A bug was fixed related to `multi_predict()` with C5.0 rule-based models (#49).
 
+* The `mtry` argument is now mapped to `colsample_bynode` rather than `colsample_bytree`. This is consistent with parsnip's interface to `xgboost` as of parsnip 0.1.6. `colsample_bytree` can still be optimized by passing it in as an engine argument to `set_engine()` (#60).
+
+* Introduced support for early stopping in `rule_fit()` via the `stop_iter` argument. See `parsnip::details_rule_fit_xrf`. Note that this is a _main_ argument to `rule_fit()` requiring parsnip 1.0.0.
 
 # rules 0.2.0
 

R/rule_fit.R

@@ -7,47 +7,71 @@ xrf_fit <-
            max_depth = 6,
            nrounds = 15,
            eta = 0.3,
-           colsample_bytree = 1,
+           colsample_bynode = NULL,
+           colsample_bytree = NULL,
            min_child_weight = 1,
            gamma = 0,
            subsample = 1,
-           lambda = 0.1,
+           validation = 0,
+           early_stop = NULL,
            counts = TRUE,
+           event_level = c("first", "second"),
+           lambda = 0.1,
            ...) {
-    mtry <-
-      process_mtry(
+    converted <-
+      parsnip::.convert_form_to_xy_fit(
+        formula = formula,
+        data = data
+      )
+
+    prefit <-
+      parsnip::xgb_train(
+        converted$x,
+        converted$y,
+        max_depth = max_depth,
+        nrounds = nrounds,
+        eta = eta,
+        colsample_bynode = colsample_bynode,
         colsample_bytree = colsample_bytree,
+        min_child_weight = min_child_weight,
+        gamma = gamma,
+        subsample = subsample,
+        validation = validation,
+        early_stop = early_stop,
+        objective = NULL,
         counts = counts,
-        n_predictors = get_num_terms(formula, data),
-        is_missing = missing(colsample_bytree)
+        event_level = event_level
       )
-    args <- list(
-      object = formula,
-      data = rlang::expr(data),
-      xgb_control =
-        list(
-          nrounds = nrounds,
-          max_depth = max_depth,
-          eta = eta,
-          colsample_bytree = mtry,
-          min_child_weight = min_child_weight,
-          gamma = gamma,
-          subsample = subsample
-        )
-    )
+
+    args <-
+      list(
+        object = formula,
+        data = rlang::expr(data),
+        prefit_xgb = prefit
+      )
+
     dots <- rlang::enquos(...)
+
+    # ignore parsnip-protected argument
+    dots[["xgb_control"]] <- NULL
+
     if (!any(names(dots) == "family")) {
       info <- get_family(formula, data)
       args$family <- info$fam
       if (info$fam == "multinomial") {
+        # have to mock an xgb_control object for xrf for now
+        args$xgb_control <- list()
         args$xgb_control$num_class <- info$classes
+        args$xgb_control$nrounds <- 10
       }
     }
     if (length(dots) > 0) {
       args <- c(args, dots)
     }
+
     cl <- rlang::call2(.fn = "xrf", .ns = "xrf", !!!args)
     res <- rlang::eval_tidy(cl)
+
     res$lambda <- lambda
     res$family <- args$family
     res$levels <- get_levels(formula, data)
@@ -96,15 +120,6 @@ process_mtry <- function(colsample_bytree, counts, n_predictors, is_missing) {
   colsample_bytree
 }
 
-# adapted from parsnip::max_mtry_formula
-get_num_terms <- function(formula, data) {
-  preds <- stats::model.frame(formula, head(data))
-  trms <- attr(preds, "terms")
-  p <- ncol(attr(trms, "factors"))
-
-  max(p, 1)
-}
-
 get_family <- function(formula, data) {
   m <- model.frame(formula, head(data))
   y <- model.response(m)

R/rule_fit_data.R

@@ -34,7 +34,7 @@ make_rule_fit <- function() {
     model = "rule_fit",
     eng = "xrf",
     parsnip = "mtry",
-    original = "colsample_bytree",
+    original = "colsample_bynode",
     func = list(pkg = "dials", fun = "mtry"),
     has_submodel = FALSE
   )
@@ -71,13 +71,22 @@ make_rule_fit <- function() {
     has_submodel = TRUE
   )
 
+  parsnip::set_model_arg(
+    model = "rule_fit",
+    eng = "xrf",
+    parsnip = "stop_iter",
+    original = "early_stop",
+    func = list(pkg = "dials", fun = "stop_iter"),
+    has_submodel = FALSE
+  )
+
   parsnip::set_fit(
     model = "rule_fit",
     eng = "xrf",
     mode = "regression",
     value = list(
       interface = "formula",
-      protect = c("formula", "data"),
+      protect = c("formula", "data", "xgb_control"),
       func = c(pkg = "rules", fun = "xrf_fit"),
       defaults = list()
     )
@@ -119,7 +128,7 @@ make_rule_fit <- function() {
     mode = "classification",
     value = list(
       interface = "formula",
-      protect = c("formula", "data"),
+      protect = c("formula", "data", "xgb_control"),
       func = c(pkg = "rules", fun = "xrf_fit"),
       defaults = list()
     )

tests/testthat/_snaps/rule-fit-regression.md

@@ -1,32 +1,22 @@
-# rule_fit handles mtry vs mtry_prop gracefully
+# early stopping works in xrf_fit
 
-    The supplied argument `mtry = 0.5` must be greater than or equal to 1. 
-
-    `mtry` is currently being interpreted as a count rather than a proportion. Supply `counts = FALSE` to `set_engine()` to supply this argument as a proportion rather than a count. 
-
-    See `?details_rule_fit_xrf` for more details.
-
----
-
-    The supplied argument `mtry = 3` must be less than or equal to 1. 
-
-    `mtry` is currently being interpreted as a proportion rather than a count. Supply `counts = TRUE` to `set_engine()` to supply this argument as a count rather than a proportion. 
-
-    See `?details_rule_fit_xrf` for more details.
+    Code
+      suppressMessages(rf_fit_3 <- fit(rf_mod_3, mpg ~ ., data = mtcars))
+    Warning <rlang_warning>
+      `early_stop` was reduced to 4.
 
----
+# xrf_fit guards xgb_control
 
     Code
-      pars_fit_8 <- rule_fit(mtry = 0.5, trees = 5) %>% set_engine("xrf",
-        colsample_bytree = 0.5) %>% set_mode("regression") %>% fit(Sale_Price ~
-        Neighborhood + Longitude + Latitude + Gr_Liv_Area + Central_Air, data = ames_data$
-        ames)
+      suppressMessages(fit(rf_mod, mpg ~ ., data = mtcars))
     Warning <rlang_warning>
-      The following arguments cannot be manually modified and were removed: colsample_bytree.
-    Error <rlang_error>
-      The supplied argument `mtry = 0.5` must be greater than or equal to 1. 
+      The following arguments cannot be manually modified and were removed: xgb_control.
+    Output
+      parsnip model object
+
+      An eXtreme RuleFit model of 7 rules.
 
-      `mtry` is currently being interpreted as a count rather than a proportion. Supply `counts = FALSE` to `set_engine()` to supply this argument as a proportion rather than a count. 
+      Original Formula:
 
-      See `?details_rule_fit_xrf` for more details.
+      mpg ~ cyl + disp + hp + drat + wt + qsec + vs + am + gear + carb 
 

tests/testthat/test-rule-fit-binomial.R

@@ -39,7 +39,7 @@ test_that("formula method", {
   rf_pred <- predict(rf_fit, ad_data$ad_pred)
   rf_prob <- predict(rf_fit, ad_data$ad_pred, type = "prob")
 
-  expect_equal(rf_fit_exp$xgb$evaluation_log, rf_fit$fit$xgb$evaluation_log)
+  expect_equal(unname(rf_fit_exp$xgb$evaluation_log), unname(rf_fit$fit$xgb$evaluation_log))
 
   expect_equal(names(rf_pred), ".pred_class")
   expect_true(tibble::is_tibble(rf_pred))
@@ -123,7 +123,7 @@ test_that("non-formula method", {
   rf_pred <- predict(rf_fit, ad_data$ad_pred)
   rf_prob <- predict(rf_fit, ad_data$ad_pred, type = "prob")
 
-  expect_equal(rf_fit_exp$xgb$evaluation_log, rf_fit$fit$xgb$evaluation_log)
+  expect_equal(unname(rf_fit_exp$xgb$evaluation_log), unname(rf_fit$fit$xgb$evaluation_log))
 
   expect_equal(names(rf_pred), ".pred_class")
   expect_true(tibble::is_tibble(rf_pred))

tests/testthat/test-rule-fit-multinomial.R

@@ -37,7 +37,7 @@ test_that("formula method", {
   rf_pred <- predict(rf_fit, hpc_data$hpc_pred)
   rf_prob <- predict(rf_fit, hpc_data$hpc_pred, type = "prob")
 
-  expect_equal(rf_fit_exp$xgb$evaluation_log, rf_fit$fit$xgb$evaluation_log)
+  expect_equal(unname(rf_fit_exp$xgb$evaluation_log), unname(rf_fit$fit$xgb$evaluation_log))
 
   expect_equal(names(rf_pred), ".pred_class")
   expect_true(tibble::is_tibble(rf_pred))
@@ -124,7 +124,7 @@ test_that("non-formula method", {
   rf_pred <- predict(rf_fit, hpc_data$hpc_pred)
   rf_prob <- predict(rf_fit, hpc_data$hpc_pred, type = "prob")
 
-  expect_equal(rf_fit_exp$xgb$evaluation_log, rf_fit$fit$xgb$evaluation_log)
+  expect_equal(unname(rf_fit_exp$xgb$evaluation_log), unname(rf_fit$fit$xgb$evaluation_log))
 
   expect_equal(names(rf_pred), ".pred_class")
   expect_true(tibble::is_tibble(rf_pred))