bdfa8c0e09
* [R] fix #1465 * [R] add sanity check to fix #1434 * [R] some clean-ups for custom obj&eval; require maximize only for early stopping
128 lines
5.2 KiB
R
128 lines
5.2 KiB
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, this argument should be \code{NULL} (default value)
|
|
#' @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).
|
|
#' @param n_first_tree limit the parsing to the \code{n} first trees.
|
|
#' If set to \code{NULL}, all trees of the model are parsed.
|
|
#'
|
|
#' @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
|
|
#' \item \code{Node}: ID of a node in a tree
|
|
#' \item \code{ID}: unique identifier of a node in a model
|
|
#' \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))
|
|
#'
|
|
#'
|
|
#' # 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,
|
|
n_first_tree = NULL){
|
|
|
|
if (!class(feature_names) %in% c("character", "NULL")) {
|
|
stop("feature_names: Has to be a vector of character\n",
|
|
" or NULL if the model dump already contains feature names.\n",
|
|
" Look at this function documentation to see where to get feature names.")
|
|
}
|
|
|
|
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 (!class(n_first_tree) %in% c("numeric", "NULL") | length(n_first_tree) > 1) {
|
|
stop("n_first_tree: Has to be a numeric vector of size 1.")
|
|
}
|
|
|
|
if (is.null(text)){
|
|
text <- xgb.dump(model = model, with_stats = T)
|
|
}
|
|
|
|
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]
|
|
|
|
n_first_tree <- min(max(td$Tree), n_first_tree)
|
|
td <- td[Tree <= n_first_tree & !grepl('^booster', t)]
|
|
|
|
td[, Node := stri_match_first_regex(t, "(\\d+):")[,2] %>% as.numeric ]
|
|
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("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"))
|