R/stackedensemble.R

In h2o: R Interface for the 'H2O' Scalable Machine Learning Platform

# This file is auto-generated by h2o-3/h2o-bindings/bin/gen_R.py
# Copyright 2016 H2O.ai;  Apache License Version 2.0 (see LICENSE for details) 
#'
# -------------------------- H2O Stacked Ensemble -------------------------- #
#'
#' Builds a Stacked Ensemble
#' 
#' Build a stacked ensemble (aka. Super Learner) using the H2O base
#' learning algorithms specified by the user.
#'
#' @param x (Optional). A vector containing the names or indices of the predictor variables to use in building the model.
#'        If x is missing, then all columns except y are used.  Training frame is used only to compute ensemble training metrics.
#' @param y The name or column index of the response variable in the data. 
#'        The response must be either a numeric or a categorical/factor variable. 
#'        If the response is numeric, then a regression model will be trained, otherwise it will train a classification model.
#' @param training_frame Id of the training data frame.
#' @param model_id Destination id for this model; auto-generated if not specified.
#' @param validation_frame Id of the validation data frame.
#' @param blending_frame Frame used to compute the predictions that serve as the training frame for the metalearner (triggers blending
#'        mode if provided)
#' @param base_models List of models or grids (or their ids) to ensemble/stack together. Grids are expanded to individual models. If
#'        not using blending frame, then models must have been cross-validated using nfolds > 1, and folds must be
#'        identical across models.
#' @param metalearner_algorithm Type of algorithm to use as the metalearner. Options include 'AUTO' (GLM with non negative weights; if
#'        validation_frame is present, a lambda search is performed), 'deeplearning' (Deep Learning with default
#'        parameters), 'drf' (Random Forest with default parameters), 'gbm' (GBM with default parameters), 'glm' (GLM
#'        with default parameters), 'naivebayes' (NaiveBayes with default parameters), or 'xgboost' (if available,
#'        XGBoost with default parameters). Must be one of: "AUTO", "deeplearning", "drf", "gbm", "glm", "naivebayes",
#'        "xgboost". Defaults to AUTO.
#' @param metalearner_nfolds Number of folds for K-fold cross-validation of the metalearner algorithm (0 to disable or >= 2). Defaults to
#'        0.
#' @param metalearner_fold_assignment Cross-validation fold assignment scheme for metalearner cross-validation.  Defaults to AUTO (which is
#'        currently set to Random). The 'Stratified' option will stratify the folds based on the response variable, for
#'        classification problems. Must be one of: "AUTO", "Random", "Modulo", "Stratified".
#' @param metalearner_fold_column Column with cross-validation fold index assignment per observation for cross-validation of the metalearner.
#' @param metalearner_params Parameters for metalearner algorithm
#' @param metalearner_transform Transformation used for the level one frame. Must be one of: "NONE", "Logit". Defaults to NONE.
#' @param max_runtime_secs Maximum allowed runtime in seconds for model training. Use 0 to disable. Defaults to 0.
#' @param weights_column Column with observation weights. Giving some observation a weight of zero is equivalent to excluding it from
#'        the dataset; giving an observation a relative weight of 2 is equivalent to repeating that row twice. Negative
#'        weights are not allowed. Note: Weights are per-row observation weights and do not increase the size of the
#'        data frame. This is typically the number of times a row is repeated, but non-integer values are supported as
#'        well. During training, rows with higher weights matter more, due to the larger loss function pre-factor. If
#'        you set weight = 0 for a row, the returned prediction frame at that row is zero and this is incorrect. To get
#'        an accurate prediction, remove all rows with weight == 0.
#' @param offset_column Offset column. This will be added to the combination of columns before applying the link function.
#' @param custom_metric_func Reference to custom evaluation function, format: `language:keyName=funcName`
#' @param seed Seed for random numbers; passed through to the metalearner algorithm. Defaults to -1 (time-based random number).
#' @param score_training_samples Specify the number of training set samples for scoring. The value must be >= 0. To use all training samples,
#'        enter 0. Defaults to 10000.
#' @param keep_levelone_frame \code{Logical}. Keep level one frame used for metalearner training. Defaults to FALSE.
#' @param export_checkpoints_dir Automatically export generated models to this directory.
#' @param auc_type Set default multinomial AUC type. Must be one of: "AUTO", "NONE", "MACRO_OVR", "WEIGHTED_OVR", "MACRO_OVO",
#'        "WEIGHTED_OVO". Defaults to AUTO.
#' @param gainslift_bins Gains/Lift table number of bins. 0 means disabled.. Default value -1 means automatic binning. Defaults to -1.
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' 
#' # Import a sample binary outcome train/test set
#' train <- h2o.importFile("https://s3.amazonaws.com/erin-data/higgs/higgs_train_10k.csv")
#' test <- h2o.importFile("https://s3.amazonaws.com/erin-data/higgs/higgs_test_5k.csv")
#' 
#' # Identify predictors and response
#' y <- "response"
#' x <- setdiff(names(train), y)
#' 
#' # For binary classification, response should be a factor
#' train[, y] <- as.factor(train[, y])
#' test[, y] <- as.factor(test[, y])
#' 
#' # Number of CV folds
#' nfolds <- 5
#' 
#' # Train & Cross-validate a GBM
#' my_gbm <- h2o.gbm(x = x,
#'                   y = y,
#'                   training_frame = train,
#'                   distribution = "bernoulli",
#'                   ntrees = 10,
#'                   max_depth = 3,
#'                   min_rows = 2,
#'                   learn_rate = 0.2,
#'                   nfolds = nfolds,
#'                   fold_assignment = "Modulo",
#'                   keep_cross_validation_predictions = TRUE,
#'                   seed = 1)
#' 
#' # Train & Cross-validate a RF
#' my_rf <- h2o.randomForest(x = x,
#'                           y = y,
#'                           training_frame = train,
#'                           ntrees = 50,
#'                           nfolds = nfolds,
#'                           fold_assignment = "Modulo",
#'                           keep_cross_validation_predictions = TRUE,
#'                           seed = 1)
#' 
#' # Train a stacked ensemble using the GBM and RF above
#' ensemble <- h2o.stackedEnsemble(x = x,
#'                                 y = y,
#'                                 training_frame = train,
#'                                 model_id = "my_ensemble_binomial",
#'                                 base_models = list(my_gbm, my_rf))
#' }
#' @export
h2o.stackedEnsemble <- function(x,
                                y,
                                training_frame,
                                model_id = NULL,
                                validation_frame = NULL,
                                blending_frame = NULL,
                                base_models = list(),
                                metalearner_algorithm = c("AUTO", "deeplearning", "drf", "gbm", "glm", "naivebayes", "xgboost"),
                                metalearner_nfolds = 0,
                                metalearner_fold_assignment = c("AUTO", "Random", "Modulo", "Stratified"),
                                metalearner_fold_column = NULL,
                                metalearner_params = NULL,
                                metalearner_transform = c("NONE", "Logit"),
                                max_runtime_secs = 0,
                                weights_column = NULL,
                                offset_column = NULL,
                                custom_metric_func = NULL,
                                seed = -1,
                                score_training_samples = 10000,
                                keep_levelone_frame = FALSE,
                                export_checkpoints_dir = NULL,
                                auc_type = c("AUTO", "NONE", "MACRO_OVR", "WEIGHTED_OVR", "MACRO_OVO", "WEIGHTED_OVO"),
                                gainslift_bins = -1)
{
  # Validate required training_frame first and other frame args: should be a valid key or an H2OFrame object
  training_frame <- .validate.H2OFrame(training_frame, required=is.null(blending_frame))
  validation_frame <- .validate.H2OFrame(validation_frame, required=FALSE)
  blending_frame <- .validate.H2OFrame(blending_frame, required=is.null(training_frame))
  if (is.null(training_frame)) training_frame <- blending_frame  # guarantee presence of default metrics

  # Validate other required args
  # If x is missing, then assume user wants to use all columns as features.
  if (missing(x)) {
     if (is.numeric(y)) {
         x <- setdiff(col(training_frame), y)
     } else {
         x <- setdiff(colnames(training_frame), y)
     }
  }

  # Validate other args
  # Get the base models from model IDs (if any) that will be used for constructing model summary
  if(!is.list(base_models) && is.vector(x)) {
    base_models <- if (inherits(base_models, "H2OGrid")) list(base_models) else as.list(base_models)
  }

  # Get base model IDs that will be passed to REST API later
  if (length(base_models) == 0) stop('base_models is empty')

  # If base_models contains models instead of ids, replace with model id
  for (i in 1:length(base_models)) {
    if (inherits(base_models[[i]], c('H2OModel', 'H2OGrid'))) {
      base_models[[i]] <- h2o.keyof(base_models[[i]])
    }
  }

  # Build parameter list to send to model builder
  parms <- list()
  parms$training_frame <- training_frame
  args <- .verify_dataxy(training_frame, x, y)
  parms$response_column <- args$y

  if (!missing(model_id))
    parms$model_id <- model_id
  if (!missing(validation_frame))
    parms$validation_frame <- validation_frame
  if (!missing(blending_frame))
    parms$blending_frame <- blending_frame
  if (!missing(base_models))
    parms$base_models <- base_models
  if (!missing(metalearner_algorithm))
    parms$metalearner_algorithm <- metalearner_algorithm
  if (!missing(metalearner_nfolds))
    parms$metalearner_nfolds <- metalearner_nfolds
  if (!missing(metalearner_fold_assignment))
    parms$metalearner_fold_assignment <- metalearner_fold_assignment
  if (!missing(metalearner_fold_column))
    parms$metalearner_fold_column <- metalearner_fold_column
  if (!missing(metalearner_transform))
    parms$metalearner_transform <- metalearner_transform
  if (!missing(max_runtime_secs))
    parms$max_runtime_secs <- max_runtime_secs
  if (!missing(weights_column))
    parms$weights_column <- weights_column
  if (!missing(offset_column))
    parms$offset_column <- offset_column
  if (!missing(custom_metric_func))
    parms$custom_metric_func <- custom_metric_func
  if (!missing(seed))
    parms$seed <- seed
  if (!missing(score_training_samples))
    parms$score_training_samples <- score_training_samples
  if (!missing(keep_levelone_frame))
    parms$keep_levelone_frame <- keep_levelone_frame
  if (!missing(export_checkpoints_dir))
    parms$export_checkpoints_dir <- export_checkpoints_dir
  if (!missing(auc_type))
    parms$auc_type <- auc_type
  if (!missing(gainslift_bins))
    parms$gainslift_bins <- gainslift_bins

  if (!missing(metalearner_params))
      parms$metalearner_params <- as.character(toJSON(metalearner_params, pretty = TRUE))

  # Error check and build model
  model <- .h2o.modelJob('stackedensemble', parms, h2oRestApiVersion=99, verbose=FALSE)

  # Convert metalearner_params back to list if not NULL
  if (!missing(metalearner_params)) {
      model@parameters$metalearner_params <- list(fromJSON(model@parameters$metalearner_params))[[1]] #Need the `[[ ]]` to avoid a nested list
  }
  return(model)
}
.h2o.train_segments_stackedensemble <- function(x,
                                                y,
                                                training_frame,
                                                validation_frame = NULL,
                                                blending_frame = NULL,
                                                base_models = list(),
                                                metalearner_algorithm = c("AUTO", "deeplearning", "drf", "gbm", "glm", "naivebayes", "xgboost"),
                                                metalearner_nfolds = 0,
                                                metalearner_fold_assignment = c("AUTO", "Random", "Modulo", "Stratified"),
                                                metalearner_fold_column = NULL,
                                                metalearner_params = NULL,
                                                metalearner_transform = c("NONE", "Logit"),
                                                max_runtime_secs = 0,
                                                weights_column = NULL,
                                                offset_column = NULL,
                                                custom_metric_func = NULL,
                                                seed = -1,
                                                score_training_samples = 10000,
                                                keep_levelone_frame = FALSE,
                                                export_checkpoints_dir = NULL,
                                                auc_type = c("AUTO", "NONE", "MACRO_OVR", "WEIGHTED_OVR", "MACRO_OVO", "WEIGHTED_OVO"),
                                                gainslift_bins = -1,
                                                segment_columns = NULL,
                                                segment_models_id = NULL,
                                                parallelism = 1)
{
  # formally define variables that were excluded from function parameters
  model_id <- NULL
  verbose <- NULL
  destination_key <- NULL
  # Validate required training_frame first and other frame args: should be a valid key or an H2OFrame object
  training_frame <- .validate.H2OFrame(training_frame, required=is.null(blending_frame))
  validation_frame <- .validate.H2OFrame(validation_frame, required=FALSE)
  blending_frame <- .validate.H2OFrame(blending_frame, required=is.null(training_frame))
  if (is.null(training_frame)) training_frame <- blending_frame  # guarantee presence of default metrics

  # Validate other required args
  # If x is missing, then assume user wants to use all columns as features.
  if (missing(x)) {
     if (is.numeric(y)) {
         x <- setdiff(col(training_frame), y)
     } else {
         x <- setdiff(colnames(training_frame), y)
     }
  }

  # Validate other args
  # Get the base models from model IDs (if any) that will be used for constructing model summary
  if(!is.list(base_models) && is.vector(x)) {
    base_models <- if (inherits(base_models, "H2OGrid")) list(base_models) else as.list(base_models)
  }

  # Get base model IDs that will be passed to REST API later
  if (length(base_models) == 0) stop('base_models is empty')

  # If base_models contains models instead of ids, replace with model id
  for (i in 1:length(base_models)) {
    if (inherits(base_models[[i]], c('H2OModel', 'H2OGrid'))) {
      base_models[[i]] <- h2o.keyof(base_models[[i]])
    }
  }

  # Build parameter list to send to model builder
  parms <- list()
  parms$training_frame <- training_frame
  args <- .verify_dataxy(training_frame, x, y)
  parms$response_column <- args$y

  if (!missing(validation_frame))
    parms$validation_frame <- validation_frame
  if (!missing(blending_frame))
    parms$blending_frame <- blending_frame
  if (!missing(base_models))
    parms$base_models <- base_models
  if (!missing(metalearner_algorithm))
    parms$metalearner_algorithm <- metalearner_algorithm
  if (!missing(metalearner_nfolds))
    parms$metalearner_nfolds <- metalearner_nfolds
  if (!missing(metalearner_fold_assignment))
    parms$metalearner_fold_assignment <- metalearner_fold_assignment
  if (!missing(metalearner_fold_column))
    parms$metalearner_fold_column <- metalearner_fold_column
  if (!missing(metalearner_transform))
    parms$metalearner_transform <- metalearner_transform
  if (!missing(max_runtime_secs))
    parms$max_runtime_secs <- max_runtime_secs
  if (!missing(weights_column))
    parms$weights_column <- weights_column
  if (!missing(offset_column))
    parms$offset_column <- offset_column
  if (!missing(custom_metric_func))
    parms$custom_metric_func <- custom_metric_func
  if (!missing(seed))
    parms$seed <- seed
  if (!missing(score_training_samples))
    parms$score_training_samples <- score_training_samples
  if (!missing(keep_levelone_frame))
    parms$keep_levelone_frame <- keep_levelone_frame
  if (!missing(export_checkpoints_dir))
    parms$export_checkpoints_dir <- export_checkpoints_dir
  if (!missing(auc_type))
    parms$auc_type <- auc_type
  if (!missing(gainslift_bins))
    parms$gainslift_bins <- gainslift_bins

  if (!missing(metalearner_params))
      parms$metalearner_params <- as.character(toJSON(metalearner_params, pretty = TRUE))

  # Build segment-models specific parameters
  segment_parms <- list()
  if (!missing(segment_columns))
    segment_parms$segment_columns <- segment_columns
  if (!missing(segment_models_id))
    segment_parms$segment_models_id <- segment_models_id
  segment_parms$parallelism <- parallelism

  # Error check and build segment models
  segment_models <- .h2o.segmentModelsJob('stackedensemble', segment_parms, parms, h2oRestApiVersion=99)
  return(segment_models)
}


.h2o.fill_stackedensemble <- function(model, parameters, allparams) {
  # Store base models for the Stacked Ensemble in user-readable form
  model$base_models <- unlist(lapply(parameters$base_models, function (base_model) base_model$name))
  
  if (!is.null(model$metalearner)) {
    model$metalearner_model <- h2o.getModel(model$metalearner$name)
  } else {
    stop(paste("Meta learner didn't get to be trained in time.",
               "Try increasing max_runtime_secs or setting it to 0 (unlimited)."))
  }

  return(model)
}