xgboost/R-package/R/xgb.model.dt.tree.R

#' Parse a boosted tree model text dump
#' 
#' Parse a boosted tree model text dump into a \code{data.table} structure.
#' 
#' @param feature_names character vector of feature names. If the model already
#'          contains feature names, those would be used when \code{feature_names=NULL} (default value).
#'          Non-null \code{feature_names} could be provided to override those in the model.
#' @param model object of class \code{xgb.Booster}
#' @param text \code{character} vector previously generated by the \code{xgb.dump} 
#'          function  (where parameter \code{with_stats = TRUE} should have been set).
#'          \code{text} takes precedence over \code{model}.
#' @param trees an integer vector of tree indices that should be parsed.
#'          If set to \code{NULL}, all trees of the model are parsed.
#'          It could be useful, e.g., in multiclass classification to get only
#'          the trees of one certain class. IMPORTANT: the tree index in xgboost models
#'          is zero-based (e.g., use \code{trees = 0:4} for first 5 trees).
#' @param ... currently not used.
#'
#' @return 
#' A \code{data.table} with detailed information about model trees' nodes.
#'
#' The columns of the \code{data.table} are:
#' 
#' \itemize{
#'  \item \code{Tree}: ID of a tree in a model (integer)
#'  \item \code{Node}: integer ID of a node in a tree (integer)
#'  \item \code{ID}: identifier of a node in a model (character)
#'  \item \code{Feature}: for a branch node, it's a feature id or name (when available);
#'              for a leaf note, it simply labels it as \code{'Leaf'}
#'  \item \code{Split}: location of the split for a branch node (split condition is always "less than")
#'  \item \code{Yes}: ID of the next node when the split condition is met
#'  \item \code{No}: ID of the next node when the split condition is not met
#'  \item \code{Missing}: ID of the next node when branch value is missing
#'  \item \code{Quality}: either the split gain (change in loss) or the leaf value
#'  \item \code{Cover}: metric related to the number of observation either seen by a split
#'                      or collected by a leaf during training.
#' } 
#' 
#' @examples
#' # Basic use:
#' 
#' data(agaricus.train, package='xgboost')
#' 
#' bst <- xgboost(data = agaricus.train$data, label = agaricus.train$label, max_depth = 2, 
#'                eta = 1, nthread = 2, nrounds = 2,objective = "binary:logistic")
#' 
#' (dt <- xgb.model.dt.tree(colnames(agaricus.train$data), bst))
#' # This bst has feature_names stored in it, so those would be used when 
#' # the feature_names parameter is not provided:
#' (dt <- xgb.model.dt.tree(model = bst))
#' 
#' # How to match feature names of splits that are following a current 'Yes' branch:
#' 
#' merge(dt, dt[, .(ID, Y.Feature=Feature)], by.x='Yes', by.y='ID', all.x=TRUE)[order(Tree,Node)]
#'  
#' @export
xgb.model.dt.tree <- function(feature_names = NULL, model = NULL, text = NULL,
                              trees = NULL, ...){
  check.deprecation(...)
  
  if (class(model) != "xgb.Booster" & class(text) != "character") {
    stop("Either 'model' has to be an object of class xgb.Booster\n",
         "  or 'text' has to be a character vector with the result of xgb.dump\n",
         "  (or NULL if the model was provided).")
  }
  
  if (is.null(feature_names) && !is.null(model) && !is.null(model$feature_names))
    feature_names <- model$feature_names
  
  if (!class(feature_names) %in% c("character", "NULL")) {
    stop("feature_names: Has to be a character vector")
  }
  
  if (!class(trees) %in% c("integer", "numeric", "NULL")) {
    stop("trees: Has to be a vector of integers.")
  }
  
  if (is.null(text)){
    text <- xgb.dump(model = model, with_stats = TRUE)
  }
  
  if (length(text) < 2 ||
      sum(stri_detect_regex(text, 'yes=(\\d+),no=(\\d+)')) < 1) {
    stop("Non-tree model detected! This function can only be used with tree models.")
  }
  
  position <- which(!is.na(stri_match_first_regex(text, "booster")))
  
  add.tree.id <- function(x, i) paste(i, x, sep = "-")
  
  anynumber_regex <- "[-+]?[0-9]*\\.?[0-9]+([eE][-+]?[0-9]+)?"
  
  td <- data.table(t=text)
  td[position, Tree := 1L]
  td[, Tree := cumsum(ifelse(is.na(Tree), 0L, Tree)) - 1L]
  
  if (is.null(trees)) {
    trees <- 0:max(td$Tree)
  } else {
    trees <- trees[trees >= 0 & trees <= max(td$Tree)]
  }
  td <- td[Tree %in% trees & !grepl('^booster', t)]
  
  td[, Node := stri_match_first_regex(t, "(\\d+):")[,2] %>% as.integer ]
  td[, ID := add.tree.id(Node, Tree)]
  td[, isLeaf := !is.na(stri_match_first_regex(t, "leaf"))]

  # parse branch lines
  td[isLeaf==FALSE, c("Feature", "Split", "Yes", "No", "Missing", "Quality", "Cover") := {
    rx <- paste0("f(\\d+)<(", anynumber_regex, ")\\] yes=(\\d+),no=(\\d+),missing=(\\d+),",
                 "gain=(", anynumber_regex, "),cover=(", anynumber_regex, ")")
    # skip some indices with spurious capture groups from anynumber_regex
    xtr <- stri_match_first_regex(t, rx)[, c(2,3,5,6,7,8,10)]
    xtr[, 3:5] <- add.tree.id(xtr[, 3:5], Tree)
    lapply(1:ncol(xtr), function(i) xtr[,i])
  }]
  # assign feature_names when available
  td[isLeaf==FALSE & !is.null(feature_names), 
     Feature := feature_names[as.numeric(Feature) + 1] ]
  
  # parse leaf lines
  td[isLeaf==TRUE, c("Feature", "Quality", "Cover") := {
    rx <- paste0("leaf=(", anynumber_regex, "),cover=(", anynumber_regex, ")")
    xtr <- stri_match_first_regex(t, rx)[, c(2,4)]
    c("Leaf", lapply(1:ncol(xtr), function(i) xtr[,i]))
  }]
  
  # convert some columns to numeric
  numeric_cols <- c("Split", "Quality", "Cover")
  td[, (numeric_cols) := lapply(.SD, as.numeric), .SDcols=numeric_cols]
  
  td[, t := NULL]
  td[, isLeaf := NULL]
  
  td[order(Tree, Node)]
}

# Avoid error messages during CRAN check.
# The reason is that these variables are never declared
# They are mainly column names inferred by Data.table...
globalVariables(c("Tree", "Node", "ID", "Feature", "t", "isLeaf",".SD", ".SDcols"))