R/rulefit.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) 
#'
# -------------------------- rulefit -------------------------- #
#'
#' Build a RuleFit Model
#' 
#' Builds a Distributed RuleFit model on a parsed dataset, for regression or 
#' classification.
#' 
#'
#' @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.
#' @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 seed Seed for random numbers (affects certain parts of the algo that are stochastic and those might or might not be enabled by default).
#'        Defaults to -1 (time-based random number).
#' @param algorithm The algorithm to use to generate rules. Must be one of: "AUTO", "DRF", "GBM". Defaults to AUTO.
#' @param min_rule_length Minimum length of rules. Defaults to 3.
#' @param max_rule_length Maximum length of rules. Defaults to 3.
#' @param max_num_rules The maximum number of rules to return. defaults to -1 which means the number of rules is selected
#'        by diminishing returns in model deviance. Defaults to -1.
#' @param model_type Specifies type of base learners in the ensemble. Must be one of: "rules_and_linear", "rules", "linear". Defaults to rules_and_linear.
#' @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 distribution Distribution function Must be one of: "AUTO", "bernoulli", "multinomial", "gaussian", "poisson", "gamma",
#'        "tweedie", "laplace", "quantile", "huber". Defaults to AUTO.
#' @param rule_generation_ntrees Specifies the number of trees to build in the tree model. Defaults to 50. Defaults to 50.
#' @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 remove_duplicates \code{Logical}. Whether to remove rules which are identical to an earlier rule. Defaults to true. Defaults to
#'        TRUE.
#' @param lambda Lambda for LASSO regressor.
#' @param max_categorical_levels For every categorical feature, only use this many most frequent categorical levels for model training. Only
#'        used for categorical_encoding == EnumLimited. Defaults to 10.
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' 
#' # Import the titanic dataset:
#' f <- "https://s3.amazonaws.com/h2o-public-test-data/smalldata/gbm_test/titanic.csv"
#' coltypes <- list(by.col.name = c("pclass", "survived"), types=c("Enum", "Enum"))
#' df <- h2o.importFile(f, col.types = coltypes)
#' 
#' # Split the dataset into train and test
#' splits <- h2o.splitFrame(data = df, ratios = 0.8, seed = 1)
#' train <- splits[[1]]
#' test <- splits[[2]]
#' 
#' # Set the predictors and response; set the factors:
#' response <- "survived"
#' predictors <- c("age", "sibsp", "parch", "fare", "sex", "pclass")
#' 
#' # Build and train the model:
#' rfit <- h2o.rulefit(y = response,
#'                     x = predictors,
#'                     training_frame = train,
#'                     max_rule_length = 10,
#'                     max_num_rules = 100,
#'                     seed = 1)
#' 
#' # Retrieve the rule importance:
#' print(rfit@model$rule_importance)
#' 
#' # Predict on the test data:
#' h2o.predict(rfit, newdata = test)
#' }
#' @export
h2o.rulefit <- function(x,
                        y,
                        training_frame,
                        model_id = NULL,
                        validation_frame = NULL,
                        seed = -1,
                        algorithm = c("AUTO", "DRF", "GBM"),
                        min_rule_length = 3,
                        max_rule_length = 3,
                        max_num_rules = -1,
                        model_type = c("rules_and_linear", "rules", "linear"),
                        weights_column = NULL,
                        distribution = c("AUTO", "bernoulli", "multinomial", "gaussian", "poisson", "gamma", "tweedie", "laplace", "quantile", "huber"),
                        rule_generation_ntrees = 50,
                        auc_type = c("AUTO", "NONE", "MACRO_OVR", "WEIGHTED_OVR", "MACRO_OVO", "WEIGHTED_OVO"),
                        remove_duplicates = TRUE,
                        lambda = NULL,
                        max_categorical_levels = 10)
{
  # 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=TRUE)
  validation_frame <- .validate.H2OFrame(validation_frame, required=FALSE)

  # 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)
     }
  }

  # Build parameter list to send to model builder
  parms <- list()
  parms$training_frame <- training_frame
  args <- .verify_dataxy(training_frame, x, y)
  parms$ignored_columns <- args$x_ignore
  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(seed))
    parms$seed <- seed
  if (!missing(algorithm))
    parms$algorithm <- algorithm
  if (!missing(min_rule_length))
    parms$min_rule_length <- min_rule_length
  if (!missing(max_rule_length))
    parms$max_rule_length <- max_rule_length
  if (!missing(max_num_rules))
    parms$max_num_rules <- max_num_rules
  if (!missing(model_type))
    parms$model_type <- model_type
  if (!missing(weights_column))
    parms$weights_column <- weights_column
  if (!missing(distribution))
    parms$distribution <- distribution
  if (!missing(rule_generation_ntrees))
    parms$rule_generation_ntrees <- rule_generation_ntrees
  if (!missing(auc_type))
    parms$auc_type <- auc_type
  if (!missing(remove_duplicates))
    parms$remove_duplicates <- remove_duplicates
  if (!missing(lambda))
    parms$lambda <- lambda
  if (!missing(max_categorical_levels))
    parms$max_categorical_levels <- max_categorical_levels

  # Error check and build model
  model <- .h2o.modelJob('rulefit', parms, h2oRestApiVersion=3, verbose=FALSE)
  return(model)
}
.h2o.train_segments_rulefit <- function(x,
                                        y,
                                        training_frame,
                                        validation_frame = NULL,
                                        seed = -1,
                                        algorithm = c("AUTO", "DRF", "GBM"),
                                        min_rule_length = 3,
                                        max_rule_length = 3,
                                        max_num_rules = -1,
                                        model_type = c("rules_and_linear", "rules", "linear"),
                                        weights_column = NULL,
                                        distribution = c("AUTO", "bernoulli", "multinomial", "gaussian", "poisson", "gamma", "tweedie", "laplace", "quantile", "huber"),
                                        rule_generation_ntrees = 50,
                                        auc_type = c("AUTO", "NONE", "MACRO_OVR", "WEIGHTED_OVR", "MACRO_OVO", "WEIGHTED_OVO"),
                                        remove_duplicates = TRUE,
                                        lambda = NULL,
                                        max_categorical_levels = 10,
                                        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=TRUE)
  validation_frame <- .validate.H2OFrame(validation_frame, required=FALSE)

  # 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)
     }
  }

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

  if (!missing(validation_frame))
    parms$validation_frame <- validation_frame
  if (!missing(seed))
    parms$seed <- seed
  if (!missing(algorithm))
    parms$algorithm <- algorithm
  if (!missing(min_rule_length))
    parms$min_rule_length <- min_rule_length
  if (!missing(max_rule_length))
    parms$max_rule_length <- max_rule_length
  if (!missing(max_num_rules))
    parms$max_num_rules <- max_num_rules
  if (!missing(model_type))
    parms$model_type <- model_type
  if (!missing(weights_column))
    parms$weights_column <- weights_column
  if (!missing(distribution))
    parms$distribution <- distribution
  if (!missing(rule_generation_ntrees))
    parms$rule_generation_ntrees <- rule_generation_ntrees
  if (!missing(auc_type))
    parms$auc_type <- auc_type
  if (!missing(remove_duplicates))
    parms$remove_duplicates <- remove_duplicates
  if (!missing(lambda))
    parms$lambda <- lambda
  if (!missing(max_categorical_levels))
    parms$max_categorical_levels <- max_categorical_levels

  # 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('rulefit', segment_parms, parms, h2oRestApiVersion=3)
  return(segment_models)
}


#' Evaluates validity of the given rules on the given data. Returns a frame with a column per each input rule id, 
#' representing a flag whether given rule is applied to the observation or not.
#'
#' @param model A trained rulefit model.  
#' @param frame A frame on which rule validity is to be evaluated
#' @param rule_ids Rule ids to be evaluated against the frame
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' titanic <- h2o.importFile(
#'  "https://s3.amazonaws.com/h2o-public-test-data/smalldata/gbm_test/titanic.csv"
#' )
#' response = "survived"
#' predictors <- c("age", "sibsp", "parch", "fare", "sex", "pclass")
#' titanic[,response] <- as.factor(titanic[,response])
#' titanic[,"pclass"] <- as.factor(titanic[,"pclass"])
#' 
#' splits <- h2o.splitFrame(data = titanic, ratios = .8, seed = 1234)
#' train <- splits[[1]]
#' test <- splits[[2]]
#' 
#' rfit <- h2o.rulefit(y = response, x = predictors, training_frame = train, validation_frame = test, 
#' min_rule_length = 1, max_rule_length = 10, max_num_rules = 100, seed = 1, model_type="rules")
#' h2o.predict_rules(rfit, train, c("M1T0N7, M1T49N7, M1T16N7", "M1T36N7", "M2T19N19"))
#' }
#' @export
h2o.predict_rules <- function(model, frame, rule_ids) {
    o <- model
    if (is(o, "H2OModel")) {
        if (o@algorithm == "rulefit"){
            return(.newExpr("rulefit.predict.rules", model@model_id, frame, rule_ids))
        } else {
            warning(paste0("No calculation available for this model"))
            return(NULL)
        }
    } else {
        warning(paste0("No calculation available for ", class(o)))
        return(NULL)
    }
}


#' This function returns the table with estimated coefficients and language representations (in case it is a rule) 
#' for each of the significant baselearners.
#'
#' @param model of the interest
#' @export
h2o.rule_importance <- function(model) {
  o <- model
  if (is(o, "H2OModel")) {
    if (o@algorithm == "rulefit"){
      parms <- list()
      parms$model_id <- model@model_id

      json <- .h2o.doSafePOST(urlSuffix = "SignificantRules", parms=parms)
      source <- .h2o.fromJSON(jsonlite::fromJSON(json,simplifyDataFrame=FALSE))

      return(source$significant_rules_table)
    } else {
      warning(paste0("No calculation available for this model"))
      return(NULL)
    }
  } else {
    warning(paste0("No calculation available for ", class(o)))
    return(NULL)
  }
}