#' 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"))