[R] parameter style consistency

This commit is contained in:
Vadim Khotilovich
2016-06-27 01:58:03 -05:00
parent 56bd442b31
commit e9eb34fabc
8 changed files with 63 additions and 94 deletions

View File

@@ -2,16 +2,11 @@
#'
#' Parse a boosted tree model text dump into a \code{data.table} structure.
#'
#' @importFrom data.table data.table
#' @importFrom data.table :=
#' @importFrom magrittr %>%
#' @importFrom stringr str_match
#'
#' @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).
#' 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.
#'
@@ -40,8 +35,8 @@
#'
#' data(agaricus.train, package='xgboost')
#'
#' bst <- xgboost(data = agaricus.train$data, label = agaricus.train$label, max.depth = 2,
#' eta = 1, nthread = 2, nround = 2,objective = "binary:logistic")
#' 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))
#'
@@ -71,12 +66,12 @@ xgb.model.dt.tree <- function(feature_names = NULL, model = NULL, text = NULL,
}
if(is.null(text)){
text <- xgb.dump(model = model, with.stats = T)
text <- xgb.dump(model = model, with_stats = T)
}
position <- which(!is.na(str_match(text, "booster")))
addTreeId <- function(x, i) paste(i,x,sep = "-")
add.tree.id <- function(x, i) paste(i, x, sep = "-")
anynumber_regex <- "[-+]?[0-9]*\\.?[0-9]+([eE][-+]?[0-9]+)?"
@@ -88,7 +83,7 @@ xgb.model.dt.tree <- function(feature_names = NULL, model = NULL, text = NULL,
td <- td[Tree <= n_first_tree & !grepl('^booster', t)]
td[, Node := str_match(t, "(\\d+):")[,2] %>% as.numeric ]
td[, ID := addTreeId(Node, Tree)]
td[, ID := add.tree.id(Node, Tree)]
td[, isLeaf := !is.na(str_match(t, "leaf"))]
# parse branch lines
@@ -97,7 +92,7 @@ xgb.model.dt.tree <- function(feature_names = NULL, model = NULL, text = NULL,
"gain=(", anynumber_regex, "),cover=(", anynumber_regex, ")")
# skip some indices with spurious capture groups from anynumber_regex
xtr <- str_match(t, rx)[, c(2,3,5,6,7,8,10)]
xtr[, 3:5] <- addTreeId(xtr[, 3:5], Tree)
xtr[, 3:5] <- add.tree.id(xtr[, 3:5], Tree)
lapply(1:ncol(xtr), function(i) xtr[,i])
}]
# assign feature_names when available
@@ -124,4 +119,4 @@ xgb.model.dt.tree <- function(feature_names = NULL, model = NULL, text = NULL,
# 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"))
globalVariables(c("Tree", "Node", "ID", "Feature", "t", "isLeaf",".SD", ".SDcols"))