random forests rule extract

DESCRIPTION

@@ -24,13 +24,15 @@ Suggests:
     C50,
     dbarts,
     grf,
+    knitr,
     lightgbm,
     palmerpenguins,
     randomForest,
     ranger,
     rpart,
     spelling,
     testthat (>= 3.0.0),
+    tidyr,
     xgboost
 Config/testthat/edition: 3
 Encoding: UTF-8

NAMESPACE

@@ -18,11 +18,15 @@ S3method(as.party,lgb.Booster)
 S3method(as.party,randomForest)
 S3method(as.party,ranger)
 S3method(as.party,xgb.Booster)
+S3method(extract_rules,C5.0)
 S3method(extract_rules,ObliqueForest)
 S3method(extract_rules,bart)
 S3method(extract_rules,cforest)
+S3method(extract_rules,grf)
 S3method(extract_rules,lgb.Booster)
 S3method(extract_rules,party)
+S3method(extract_rules,randomForest)
+S3method(extract_rules,ranger)
 S3method(extract_rules,rpart)
 S3method(extract_rules,xgb.Booster)
 S3method(var_imp,ObliqueForest)

R/C5.0.R

@@ -806,6 +806,72 @@ c5_extract_one <- function(tree_num, tree_lines, num_trials) {
   new_active_predictors(active_vars, tree = tree_num)
 }
 
+# ------------------------------------------------------------------------------
+# Extract rules from C5.0
+
+# Internal helper: extract rules for one tree from C5.0
+c5_extract_rules_one <- function(tree_num, x, data) {
+  # Convert to party
+  tree_party <- as.party(x, tree = tree_num, data = data)
+
+  # Extract rules using party method
+  rules <- extract_rules.party(tree_party)
+
+  # Add tree column
+  rules$tree <- tree_num
+
+  rules
+}
+
+#' @rdname extract_rules
+#' @param tree Integer vector specifying which trees (boosting trials) to
+#'   extract rules from. Default is `1L` for the first tree. Values must be
+#'   between 1 and the number of actual trials (`x$trials["Actual"]`).
+#' @param data Data.frame containing the training data. Required for C5.0
+#'   models to properly parse tree structure with correct factor levels.
+#' @export
+extract_rules.C5.0 <- function(x, tree = 1L, data = NULL, ...) {
+  rlang::check_installed("C50")
+
+  # Require data parameter
+  if (is.null(data)) {
+    cli::cli_abort(
+      "{.arg data} is required for {.fn extract_rules.C5.0}.",
+      "i" = "Provide the training data to extract rules correctly."
+    )
+  }
+
+  # Validate tree argument
+  if (!is.numeric(tree) || !all(tree == as.integer(tree))) {
+    cli::cli_abort(
+      "{.arg tree} must be an integer vector, not {.obj_type_friendly {tree}}.",
+      call = rlang::caller_env()
+    )
+  }
+
+  tree <- as.integer(tree)
+
+  # Get number of trials
+  num_trials <- x$trials["Actual"]
+
+  # Validate tree range
+  if (any(tree < 1L) || any(tree > num_trials)) {
+    cli::cli_abort(
+      "{.arg tree} values must be between 1 and {num_trials}.",
+      call = rlang::caller_env()
+    )
+  }
+
+  # Extract for each tree
+  results <- lapply(tree, c5_extract_rules_one, x = x, data = data)
+
+  # Combine and sort by tree then id
+  dplyr::bind_rows(results) |>
+    dplyr::arrange(tree, id)
+}
+
+# ------------------------------------------------------------------------------
+
 #' @rdname active_predictors
 #' @param tree Integer vector specifying which trees (boosting trials) to
 #'   extract active predictors from. Default is `1L` for the first tree.

R/ObliqueForest.R

@@ -500,6 +500,26 @@ active_predictors.ObliqueForest <- function(x, tree = 1L, ...) {
 
 #' @export
 #' @rdname lorax_var_imp
+#' @details
+#'
+#' Different engines compute importances differently:
+#'
+#'  - [rpart::rpart()], [xgboost::xgb.importance()], and
+#'  [lightgbm::lgb.importance()] follow the change in the objective function
+#'  (e.g., Gini, MSE, gain, ...) as the tree is constructed and reports the
+#'  aggregate improvement in these statistics as importance.
+#'
+#' - [randomForest::importance()] and [ranger::ranger()] produce standard
+#' permutation-based importance scores.
+#'
+#' - [grf::variable_importance()] states that a "simple weighted sum of how
+#' many times feature i was split on at each depth in the forest" is used.
+#'
+#' Keep in mind that, for [rpart::rpart()], the importance calculation is
+#' affected by competing and surrogate splits. Consequently, there might be
+#' non-zero importances for predictors that were not used in any actual split
+#' in the tree. To make the splits and importances align, use the options
+#' `maxcompete = 0` and `maxsurrogate = 0`.
 var_imp.ObliqueForest <- function(object, complete = TRUE, ...) {
   rlang::check_installed("aorsf")
 

R/grf.R

@@ -302,6 +302,63 @@ grf_find_max_split_var <- function(all_nodes) {
   max_var
 }
 
+# ------------------------------------------------------------------------------
+# Extract rules from grf
+
+# Internal helper: extract rules for one tree from grf
+grf_extract_rules_one <- function(tree_num, x) {
+  # Convert to party
+  tree_party <- as.party(x, tree = tree_num)
+
+  # Extract rules using party method
+  rules <- extract_rules.party(tree_party)
+
+  # Add tree column
+  rules$tree <- tree_num
+
+  rules
+}
+
+#' @rdname extract_rules
+#' @param tree Integer vector specifying which trees to extract rules from.
+#'   Default is `1L` for the first tree. Values must be between 1 and the
+#'   number of trees in the forest.
+#' @export
+extract_rules.grf <- function(x, tree = 1L, ...) {
+  rlang::check_installed("grf")
+
+  # Validate tree argument
+  if (!is.numeric(tree) || !all(tree == as.integer(tree))) {
+    cli::cli_abort(
+      "{.arg tree} must be an integer vector, not {.obj_type_friendly {tree}}.",
+      call = rlang::caller_env()
+    )
+  }
+
+  tree <- as.integer(tree)
+
+  # Get number of trees
+  num_trees <- x$`_num_trees`
+  if (is.null(num_trees)) {
+    num_trees <- 1000 # Default grf value
+  }
+
+  # Validate tree range
+  if (any(tree < 1L) || any(tree > num_trees)) {
+    cli::cli_abort(
+      "{.arg tree} values must be between 1 and {num_trees}.",
+      call = rlang::caller_env()
+    )
+  }
+
+  # Extract for each tree
+  results <- lapply(tree, grf_extract_rules_one, x = x)
+
+  # Combine and sort by tree then id
+  dplyr::bind_rows(results) |>
+    dplyr::arrange(tree, id)
+}
+
 # ------------------------------------------------------------------------------
 # Variable importance Wrapper
 

R/randomForest.R

@@ -343,6 +343,68 @@ rf_build_partynode <- function(
   )
 }
 
+# ------------------------------------------------------------------------------
+# Extract rules from randomForest
+
+# Internal helper: extract rules for one tree from randomForest
+rf_extract_rules_one <- function(tree_num, x, data) {
+  # Convert to party
+  tree_party <- as.party(x, tree = tree_num, data = data)
+
+  # Extract rules using party method
+  rules <- extract_rules.party(tree_party)
+
+  # Add tree column
+  rules$tree <- tree_num
+
+  rules
+}
+
+#' @rdname extract_rules
+#' @param tree Integer vector specifying which trees to extract rules from.
+#'   Default is `1L` for the first tree. Values must be between 1 and the
+#'   number of trees in the forest (`x$ntree`).
+#' @param data Optional data.frame containing the training data. If NULL,
+#'   a placeholder will be created. Providing data enables better rule
+#'   extraction with proper variable context.
+#' @export
+extract_rules.randomForest <- function(x, tree = 1L, data = NULL, ...) {
+  rlang::check_installed("randomForest")
+
+  # Validate tree argument
+  if (!is.numeric(tree) || !all(tree == as.integer(tree))) {
+    cli::cli_abort(
+      "{.arg tree} must be an integer vector, not {.obj_type_friendly {tree}}.",
+      call = rlang::caller_env()
+    )
+  }
+
+  tree <- as.integer(tree)
+
+  # Check that forest exists
+  if (is.null(x$forest)) {
+    cli::cli_abort(
+      "{.pkg randomForest} model must have {.code keep.forest = TRUE} to extract rules.",
+      call = rlang::caller_env()
+    )
+  }
+
+  # Validate tree range
+  if (any(tree < 1L) || any(tree > x$ntree)) {
+    cli::cli_abort(
+      "{.arg tree} values must be between 1 and {x$ntree}.",
+      call = rlang::caller_env()
+    )
+  }
+
+  # Extract for each tree
+  results <- lapply(tree, rf_extract_rules_one, x = x, data = data)
+
+  # Combine and sort by tree then id
+  dplyr::bind_rows(results) |>
+    dplyr::arrange(tree, id)
+}
+
 # ------------------------------------------------------------------------------
 
 # Internal helper: extract active predictors for one tree and wrap in constructor

R/ranger.R

@@ -245,6 +245,75 @@ ranger_build_partynode_from_info <- function(node_id, tree_info, var_names) {
   )
 }
 
+# ------------------------------------------------------------------------------
+# Extract rules from ranger
+
+# Internal helper: extract rules for one tree from ranger
+ranger_extract_rules_one <- function(tree_num, x, data) {
+  # Convert to party
+  tree_party <- as.party(x, tree = tree_num, data = data)
+
+  # Extract rules using party method
+  rules <- extract_rules.party(tree_party)
+
+  # Add tree column
+  rules$tree <- tree_num
+
+  rules
+}
+
+#' @rdname extract_rules
+#' @param tree Integer vector specifying which trees to extract rules from.
+#'   Default is `1L` for the first tree. Values must be between 1 and the
+#'   number of trees in the forest (`x$num.trees`).
+#' @param data Data.frame containing the training data. Required for ranger
+#'   models to properly extract rules with fitted values and node summaries.
+#' @export
+extract_rules.ranger <- function(x, tree = 1L, data = NULL, ...) {
+  rlang::check_installed("ranger")
+
+  # Require data parameter
+  if (is.null(data)) {
+    cli::cli_abort(
+      "{.arg data} is required for {.fn extract_rules.ranger}.",
+      "i" = "Provide the training data to extract rules correctly."
+    )
+  }
+
+  # Validate tree argument
+  if (!is.numeric(tree) || !all(tree == as.integer(tree))) {
+    cli::cli_abort(
+      "{.arg tree} must be an integer vector, not {.obj_type_friendly {tree}}.",
+      call = rlang::caller_env()
+    )
+  }
+
+  tree <- as.integer(tree)
+
+  # Check that forest exists
+  if (is.null(x$forest)) {
+    cli::cli_abort(
+      "{.pkg ranger} model must have {.code write.forest = TRUE} to extract rules.",
+      call = rlang::caller_env()
+    )
+  }
+
+  # Validate tree range
+  if (any(tree < 1L) || any(tree > x$num.trees)) {
+    cli::cli_abort(
+      "{.arg tree} values must be between 1 and {x$num.trees}.",
+      call = rlang::caller_env()
+    )
+  }
+
+  # Extract for each tree
+  results <- lapply(tree, ranger_extract_rules_one, x = x, data = data)
+
+  # Combine and sort by tree then id
+  dplyr::bind_rows(results) |>
+    dplyr::arrange(tree, id)
+}
+
 # ------------------------------------------------------------------------------
 
 # Internal helper: extract active predictors for one tree and wrap in constructor