view release on metacpan or  search on metacpan

xgboost/R-package/R/xgb.train.R  view on Meta::CPAN

  # Construct a booster (either a new one or load from xgb_model)
  handle <- xgb.Booster.handle(params, append(watchlist, dtrain), xgb_model)
  bst <- xgb.handleToBooster(handle)

  # extract parameters that can affect the relationship b/w #trees and #iterations
  num_class <- max(as.numeric(NVL(params[['num_class']], 1)), 1)
  num_parallel_tree <- max(as.numeric(NVL(params[['num_parallel_tree']], 1)), 1)

  # When the 'xgb_model' was set, find out how many boosting iterations it has
  niter_init <- 0
  if (!is.null(xgb_model)) {
    niter_init <- as.numeric(xgb.attr(bst, 'niter')) + 1
    if (length(niter_init) == 0) {
      niter_init <- xgb.ntree(bst) %/% (num_parallel_tree * num_class)
    }
  }
  if(is_update && nrounds > niter_init)
    stop("nrounds cannot be larger than ", niter_init, " (nrounds of xgb_model)")

  # TODO: distributed code
  rank <- 0
  
  niter_skip <- ifelse(is_update, 0, niter_init)
  begin_iteration <- niter_skip + 1
  end_iteration <- niter_skip + nrounds
  
  # the main loop for boosting iterations
  for (iteration in begin_iteration:end_iteration) {
    
    for (f in cb$pre_iter) f()
    
    xgb.iter.update(bst$handle, dtrain, iteration - 1, obj)
    
    bst_evaluation <- numeric(0)
    if (length(watchlist) > 0)
      bst_evaluation <- xgb.iter.eval(bst$handle, watchlist, iteration - 1, feval)
    
    xgb.attr(bst$handle, 'niter') <- iteration - 1

    for (f in cb$post_iter) f()

    if (stop_condition) break
  }
  for (f in cb$finalize) f(finalize = TRUE)
  
  bst <- xgb.Booster.complete(bst, saveraw = TRUE)
  
  # store the total number of boosting iterations
  bst$niter = end_iteration

  # store the evaluation results
  if (length(evaluation_log) > 0 &&
      nrow(evaluation_log) > 0) {
    # include the previous compatible history when available
    if (inherits(xgb_model, 'xgb.Booster') &&
        !is_update &&
        !is.null(xgb_model$evaluation_log) &&
        all.equal(colnames(evaluation_log),
                  colnames(xgb_model$evaluation_log))) {
      evaluation_log <- rbindlist(list(xgb_model$evaluation_log, evaluation_log))
    }
    bst$evaluation_log <- evaluation_log
  }

  bst$call <- match.call()
  bst$params <- params
  bst$callbacks <- callbacks
  if (!is.null(colnames(dtrain)))
    bst$feature_names <- colnames(dtrain)
  
  return(bst)
}