R/models.R

Defines functions h2o.reset_threshold h2o.upload_mojo h2o.import_mojo h2o.genericModel get_seed.H2OModel print.h2o.stackedEnsemble.summary h2o.getModelTree .h2o.walk_tree print.H2OTree print.H2ONode h2o.deepfeatures reShape replaceEnumLevel h2o.partialPlot h2o.cross_validation_predictions h2o.cross_validation_holdout_predictions h2o.cross_validation_fold_assignment h2o.cross_validation_models plot.H2OTabulate h2o.tabulate .h2o.getAlgoVersion .h2o.unifyAlgoName .isSupervised .warn.no.cross.validation .warn.no.validation .model.parts h2o.sdev screeplot.H2ODimReductionModel plot.H2OBinomialUpliftMetrics plot.H2OBinomialMetrics h2o.std_coef_plot h2o.varimp_plot plot.H2OModel h2o.null_dof h2o.residual_dof h2o.residual_deviance h2o.null_deviance h2o.cluster_sizes h2o.centroid_stats h2o.num_iterations h2o.totss h2o.betweenss h2o.tot_withinss h2o.withinss h2o.centersSTD h2o.centers h2o.find_row_by_threshold h2o.find_threshold_by_max_metric h2o.specificity h2o.missrate h2o.fallout h2o.sensitivity h2o.recall h2o.tnr h2o.fnr h2o.fpr h2o.tpr h2o.precision h2o.mcc h2o.mean_per_class_accuracy h2o.maxPerClassError h2o.error h2o.accuracy h2o.F2 h2o.F1 h2o.F0point5 h2o.metric h2o.hit_ratio_table h2o.biases h2o.weights h2o.h h2o.feature_interaction h2o.get_ntrees_actual h2o.scoreHistoryGAM h2o.scoreHistory h2o.varsplits h2o.logloss h2o.rmsle h2o.mae h2o.rmse h2o.mse grabCoeff h2o.coef_norm grabOneModelCoef h2o.coef h2o.giniCoef h2o.HGLMMetrics h2o.mean_residual_deviance h2o.r2 h2o.aic h2o.mean_per_class_error h2o.pr_auc h2o.multinomial_aucpr_table h2o.aucpr h2o.multinomial_auc_table .h2o.perfect_auc h2o.aecu_table h2o.aecu h2o.qini h2o.thresholds_and_metric_scores h2o.auuc_table h2o.auuc h2o.auc h2o.make_metrics h2o.performance feature_frequencies.H2OModel predict_contributions.H2OModel staged_predict_proba.H2OModel h2o.crossValidate h2o.result predict_leaf_node_assignment.H2OModel h2o.predict.H2OModel h2o.predict predict.H2OModel .h2o.checkAndUnifyHyperParameters .collapse.tuple .collapse.tuple.key_value .collapse.list.of.list.string .collapse.tuple.string .escape.string .h2o.transformParam .h2o.checkParam .is.int53 .is.int64 .h2o.checkAndUnifyModelParameters .h2o.getModelParameters .h2o.prepareModelParameters .h2o.getFutureModel .h2o.pollModelUpdates .h2o.createModel .h2o.validateModelParameters .h2o.getFutureSegmentModels .h2o.segmentModelsJob .h2o.startSegmentModelsJob .h2o.processResponseWarnings .h2o.makeModelParams .h2o.startModelJob .h2o.modelJob .build_cm .verify_datacols .verify_dataxy

Documented in feature_frequencies.H2OModel get_seed.H2OModel h2o.accuracy h2o.aecu h2o.aecu_table h2o.aic h2o.auc h2o.aucpr h2o.auuc h2o.auuc_table h2o.betweenss h2o.biases h2o.centers h2o.centersSTD h2o.centroid_stats h2o.cluster_sizes h2o.coef h2o.coef_norm h2o.cross_validation_fold_assignment h2o.cross_validation_holdout_predictions h2o.cross_validation_models h2o.cross_validation_predictions h2o.deepfeatures h2o.error h2o.F0point5 h2o.F1 h2o.F2 h2o.fallout h2o.feature_interaction h2o.find_row_by_threshold h2o.find_threshold_by_max_metric h2o.fnr h2o.fpr h2o.genericModel h2o.getModelTree h2o.get_ntrees_actual h2o.giniCoef h2o.h h2o.HGLMMetrics h2o.hit_ratio_table h2o.import_mojo h2o.logloss h2o.mae h2o.make_metrics h2o.maxPerClassError h2o.mcc h2o.mean_per_class_accuracy h2o.mean_per_class_error h2o.mean_residual_deviance h2o.metric h2o.missrate h2o.mse h2o.multinomial_aucpr_table h2o.multinomial_auc_table h2o.null_deviance h2o.null_dof h2o.num_iterations h2o.partialPlot .h2o.perfect_auc h2o.performance h2o.pr_auc h2o.precision h2o.predict h2o.predict.H2OModel h2o.qini h2o.r2 h2o.recall h2o.reset_threshold h2o.residual_deviance h2o.residual_dof h2o.rmse h2o.rmsle h2o.scoreHistory h2o.scoreHistoryGAM h2o.sdev h2o.sensitivity h2o.specificity h2o.std_coef_plot h2o.tabulate h2o.thresholds_and_metric_scores h2o.tnr h2o.totss h2o.tot_withinss h2o.tpr h2o.upload_mojo h2o.varimp_plot h2o.varsplits h2o.weights h2o.withinss plot.H2OModel plot.H2OTabulate predict_contributions.H2OModel predict.H2OModel predict_leaf_node_assignment.H2OModel staged_predict_proba.H2OModel .verify_dataxy

#'
#' H2O Model Related Functions
#'
#' @importFrom graphics strwidth par legend polygon arrows points grid
#' @importFrom grDevices dev.copy dev.off png rainbow adjustcolor

NULL

#-----------------------------------------------------------------------------------------------------------------------
#   Helper Functions
#-----------------------------------------------------------------------------------------------------------------------

#'
#' Used to verify data, x, y and turn into the appropriate things
#'
#' @param data H2OFrame
#' @param x features
#' @param y response
#' @param autoencoder autoencoder flag
.verify_dataxy <- function(data, x, y, autoencoder = FALSE) {
   if (is(x, "H2OInfogram"))
     x<-x@admissible_features
  if(!is.null(x) && !is.character(x) && !is.numeric(x)) # only check if x is not null
    stop('`x` must be column names or indices')
  if( !autoencoder )
    if(!is.character(y) && !is.numeric(y))
      stop('`y` must be a column name or index')

  cc <- colnames(chk.H2OFrame(data))
  
  if (!is.null(x)) {
    if(is.character(x)) {
      if(!all(x %in% cc))
        stop("Invalid column names: ", paste(x[!(x %in% cc)], collapse = ','))
      x_i <- match(x, cc)
    } else {
      if(any( x < 1L | x > attr(x,'ncol')))
        stop('out of range explanatory variable ', paste(x[x < 1L | x > length(cc)], collapse = ','))
      x_i <- x
      x <- cc[x_i]
    }
  } else {
    x_i <- NULL
  }

  x_ignore <- c()
  if( !autoencoder ) {
    if(is.character(y)){
      if(!(y %in% cc))
        stop(y, ' is not a column name')
      y_i <- which(y == cc)
    } else {
      if(y < 1L || y > length(cc))
        stop('response variable index ', y, ' is out of range')
      y_i <- y
      y <- cc[y]
    }

    if(!is.null(x) && !autoencoder && (y %in% x)) {
      warning('removing response variable from the explanatory variables')
      x <- setdiff(x,y)
    }
    x_ignore <- setdiff(setdiff(cc, x), y)
    if( length(x_ignore) == 0L ) x_ignore <- ''
    return(list(x=x, y=y, x_i=x_i, x_ignore=x_ignore, y_i=y_i))
  } else {
    x_ignore <- setdiff(cc, x)
    if( !missing(y) ) stop("`y` should not be specified for autoencoder=TRUE, remove `y` input")
    return(list(x=x,x_i=x_i,x_ignore=x_ignore))
  }
}

.verify_datacols <- function(data, cols) {
  if(!is.character(cols) && !is.numeric(cols))
    stop('`cols` must be column names or indices')

  cc <- colnames(chk.H2OFrame(data))
  if(length(cols) == 1L && cols == '')
    cols <- cc
  if(is.character(cols)) {
    if(!all(cols %in% cc))
      stop("Invalid column names: ", paste(cols[which(!cols %in% cc)], collapse=", "))
    cols_ind <- match(cols, cc)
  } else {
    if(any(cols < 1L | cols > length(cc)))
      stop('out of range explanatory variable ', paste(cols[cols < 1L | cols > length(cc)], collapse=','))
    cols_ind <- cols
    cols <- cc[cols_ind]
  }

  cols_ignore <- setdiff(cc, cols)
  if( length(cols_ignore) == 0L )
    cols_ignore <- ''
  list(cols=cols, cols_ind=cols_ind, cols_ignore=cols_ignore)
}

.build_cm <- function(cm, actual_names = NULL, predict_names = actual_names, transpose = TRUE) {
  categories <- length(cm)
  cf_matrix <- matrix(unlist(cm), nrow=categories)
  if(transpose)
    cf_matrix <- t(cf_matrix)

  cf_total <- apply(cf_matrix, 2L, sum)
  cf_error <- c(1 - diag(cf_matrix)/apply(cf_matrix,1L,sum), 1 - sum(diag(cf_matrix))/sum(cf_matrix))
  cf_matrix <- rbind(cf_matrix, cf_total)
  cf_matrix <- cbind(cf_matrix, round(cf_error, 3L))

  if(!is.null(actual_names))
    dimnames(cf_matrix) = list(Actual = c(actual_names, "Totals"), Predicted = c(predict_names, "Error"))
  cf_matrix
}


.h2o.modelJob <- function( algo, params, h2oRestApiVersion=.h2o.__REST_API_VERSION, verbose=FALSE) {
  if( !is.null(params$validation_frame) )
    .eval.frame(params$training_frame)
  if( !is.null(params$validation_frame) )
    .eval.frame(params$validation_frame)
  if (length(grep("stopping_metric", attributes(params)))>0) {
    if (params$stopping_metric=="r2")
      stop("r2 cannot be used as an early stopping_metric yet.  Check this JIRA https://0xdata.atlassian.net/browse/PUBDEV-5381 for progress.")
  }
  if (algo=="pca" && is.null(params$k)) # make sure to set k=1 for default for pca
    params$k=1
  job <- .h2o.startModelJob(algo, params, h2oRestApiVersion)
  .h2o.getFutureModel(job, verbose = verbose)
}

.h2o.startModelJob <- function(algo, params, h2oRestApiVersion) {
  .key.validate(params$key)
  #---------- Params ----------#
  param_values <- .h2o.makeModelParams(algo, params, h2oRestApiVersion)
  #---------- Build! ----------#
  res <- .h2o.__remoteSend(method = "POST", .h2o.__MODEL_BUILDERS(algo), .params = param_values, h2oRestApiVersion = h2oRestApiVersion)
  .h2o.processResponseWarnings(res)
  #---------- Output ----------#
  job_key  <- res$job$key$name
  dest_key <- res$job$dest$name
  new("H2OModelFuture",job_key=job_key, model_id=dest_key)
}

.h2o.makeModelParams <- function(algo, params, h2oRestApiVersion) {
  #---------- Force evaluate temporary ASTs ----------#
  ALL_PARAMS <- .h2o.__remoteSend(method = "GET", h2oRestApiVersion = h2oRestApiVersion, .h2o.__MODEL_BUILDERS(algo))$model_builders[[algo]]$parameters
  #---------- Check user parameter types ----------#
  param_values <- .h2o.checkAndUnifyModelParameters(algo = algo, allParams = ALL_PARAMS, params = params)
  #---------- Validate parameters ----------#
  #.h2o.validateModelParameters(algo, param_values, h2oRestApiVersion)
  return(param_values)
}

.h2o.processResponseWarnings <- function(res) {
  if(length(res$messages) != 0L){
    warn <- lapply(res$messages, function(y) {
      if (inherits(y, "list") && y$message_type == "WARN" )
        paste0(y$message, ".\n")
      else ""
    })
    if(any(nzchar(warn))) warning(warn)
  }
}

.h2o.startSegmentModelsJob <- function(algo, segment_params, params, h2oRestApiVersion) {
  #---------- Params ----------#
  param_values <- .h2o.makeModelParams(algo, params, h2oRestApiVersion)
  param_values$segment_models_id <- segment_params$segment_models_id
  param_values$segment_columns <- .collapse.char(segment_params$segment_columns)
  param_values$parallelism <- segment_params$parallelism 
  #---------- Build! ----------#
  job <- .h2o.__remoteSend(method = "POST", .h2o.__SEGMENT_MODELS_BUILDERS(algo), .params = param_values, h2oRestApiVersion = h2oRestApiVersion)
  job_key  <- job$key$name
  dest_key <- job$dest$name
  new("H2OSegmentModelsFuture",job_key=job_key, segment_models_id=dest_key)
}

.h2o.segmentModelsJob <- function(algo, segment_params, params, h2oRestApiVersion) {
  .key.validate(segment_params$segment_models_id)
  sm <- .h2o.startSegmentModelsJob(algo, segment_params, params, h2oRestApiVersion)
  .h2o.getFutureSegmentModels(sm)
}

.h2o.getFutureSegmentModels <- function(object) {
  .h2o.__waitOnJob(object@job_key)
  h2o.get_segment_models(object@segment_models_id)
}

#
# Validate given parameters against algorithm parameters validation
# REST end-point. Stop execution in case of validation error.
#
.h2o.validateModelParameters <- function(algo, params, h2oRestApiVersion = .h2o.__REST_API_VERSION) {
  validation <- .h2o.__remoteSend(method = "POST", paste0(.h2o.__MODEL_BUILDERS(algo), "/parameters"), .params = params, h2oRestApiVersion = h2oRestApiVersion)
  if(length(validation$messages) != 0L) {
    error <- lapply(validation$messages, function(x) {
      if( x$message_type == "ERRR" )
        paste0(x$message, ".\n")
      else ""
    })
    if(any(nzchar(error))) stop(error)
    warn <- lapply(validation$messages, function(i) {
      if( i$message_type == "WARN" )
        paste0(i$message, ".\n")
      else ""
    })
    if(any(nzchar(warn))) warning(warn)
  }
}

.h2o.createModel <- function(algo, params, h2oRestApiVersion = .h2o.__REST_API_VERSION) {
  .h2o.getFutureModel(.h2o.startModelJob(algo, params, h2oRestApiVersion))
}

.h2o.pollModelUpdates <- function(job) {
  cat(paste0("\nScoring History for Model ",job$dest$name, " at ", Sys.time(),"\n"))
  print(paste0("Model Build is ", job$progress*100, "% done..."))
  if(!is.null(job$progress_msg)){
  #   print(tail(h2o.getModel(job$dest$name)@model$scoring_history))
  }else{
    print("Scoring history is not available yet...") #Catch 404 with scoring history. Can occur when nfolds >=2
  }
}

.h2o.getFutureModel <- function(object, verbose=FALSE) {
  .h2o.__waitOnJob(object@job_key, pollUpdates=ifelse(verbose, .h2o.pollModelUpdates, as.null))
  h2o.getModel(object@model_id)
}

.h2o.prepareModelParameters <- function(algo, params, is_supervised) {
  if (!is.null(params$training_frame))
    params$training_frame <- chk.H2OFrame(params$training_frame)
  if (!is.null(params$validation_frame))
    params$validation_frame <- chk.H2OFrame(params$validation_frame)

  # Check if specified model request is for supervised algo
  isSupervised <- if (!is.null(is_supervised)) is_supervised else .isSupervised(algo, params)

  if (isSupervised) {
    if (!is.null(params$x)) { x <- params$x; params$x <- NULL }
    if (!is.null(params$y)) { y <- params$y; params$y <- NULL }
    args <- .verify_dataxy(params$training_frame, x, y)
    if( !is.null(params$offset_column) && !is.null(params$offset_column))  args$x_ignore <- args$x_ignore[!( params$offset_column == args$x_ignore )]
    if( !is.null(params$weights_column) && !is.null(params$weights_column)) args$x_ignore <- args$x_ignore[!( params$weights_column == args$x_ignore )]
    if( !is.null(params$fold_column) && !is.null(params$fold_column)) args$x_ignore <- args$x_ignore[!( params$fold_column == args$x_ignore )]
    params$ignored_columns <- args$x_ignore
    params$response_column <- args$y
  } else {
    if (!is.null(params$x)) {
      x <- params$x
      params$x <- NULL
      args <- .verify_datacols(params$training_frame, x)
      params$ignored_columns <- args$cols_ignore
    }
  }
  # Note: Magic copied from start .h2o.startModelJob
  params <- lapply(params, function(x) { if(is.integer(x)) x <- as.numeric(x); x })
  params
}

.h2o.getModelParameters <- function(algo, h2oRestApiVersion = .h2o.__REST_API_VERSION) {
  .h2o.__remoteSend(method = "GET", .h2o.__MODEL_BUILDERS(algo), h2oRestApiVersion = h2oRestApiVersion)$model_builders[[algo]]$parameters
}

.h2o.checkAndUnifyModelParameters <- function(algo, allParams, params, hyper_params = list()) {
  addGamCol <- FALSE
  if (algo == "gam") {# gam_column is specified in subspace and need to fake something here
    if (is.null(params$gam_columns) && !(is.null(hyper_params$subspaces)) && !(is.null(hyper_params$subspaces[[1]]$gam_columns))) {
      addGamCol <- TRUE
      params$gam_columns = list("C1")  # set default gam_columns
    }
  }
  # First verify all parameters
  error <- lapply(allParams, function(i) {
    e <- ""
    name <- i$name
    # R treats integer as not numeric
    if(is.integer(params[[name]])){
      params[[name]] <- as.numeric(params[[name]])
    }
    if (i$required && !((name %in% names(params)) || (name %in% names(hyper_params)))) {
      e <- paste0("argument \"", name, "\" is missing, with no default\n")
    } else if (name %in% names(params)) {
      e <- .h2o.checkParam(i, params[[name]])
      if (!nzchar(e)) {
        params[[name]] <<- .h2o.transformParam(i, params[[name]])
      }
    }
    e
  })

  if (addGamCol)
    params$gam_columns <- NULL
  
  if(any(nzchar(error)))
    stop(error)

  #---------- Create parameter list to pass ----------#
  param_values <- lapply(params, function(i) {
    if(is.H2OFrame(i))  h2o.getId(i)
    else             i
  })

  param_values
}

# Long precision
.is.int64 <- function(v) {
  number <- suppressWarnings(as.numeric(v))
  if(is.na(number)) FALSE
  else number > -2^63 & number < 2^63 & (floor(number)==ceiling(number))
}

# Precise int in double presision
.is.int53 <- function(v) {
    number <- suppressWarnings(as.numeric(v))
    if(is.na(number)) FALSE
    else number > -2^53 & number < 2^53 & (floor(number)==ceiling(number))
}

# Check definition of given parameters in given list of parameters
# Returns error message or empty string
# Note: this function has no side-effects!
.h2o.checkParam <- function(paramDef, paramValue) {
  e <- ""
  # Fetch mapping for given Java to R types
  mapping <- .type.map[paramDef$type,]
  type    <- mapping[1L, 1L]
  scalar  <- mapping[1L, 2L]
  name    <- paramDef$name
  if (is.na(type))
    stop("Cannot find type ", paramDef$type, " in .type.map")
  if (scalar) { # scalar == TRUE
    if (type == "H2OModel")
      type <-  "character"
      if (name == "seed") {
        if(is.character(paramValue) && !.is.int64(paramValue))
          e <- paste0("\"seed\" must be of type long or string long, but got a string which cannot be converted to long.\n")
        else if(is.numeric(paramValue)){
          if(!.is.int64(paramValue)){
            e <- paste0("\"seed\" must be of type long or string long, but got a number which cannot be converted to long.\n")
          } else if(!.is.int53(paramValue)) {
              warning("R can handle only 53-bit integer without loss. 
              If you need to use a less/larger number than the integer, pass seed parameter as the string number. Otherwise, the seed could be inconsistent.
              (For example, if you need to use autogenerated seed like -8664354335142703762 from H2O server.)")
          }
        }
      } else {
        if (!inherits(paramValue, type)) {
          e <- paste0(e, "\"", name , "\" must be of type ", type, ", but got ", class(paramValue), ".\n")
        } else if ((length(paramDef$values) > 1L) && (is.null(paramValue) || !(tolower(paramValue) %in% tolower(paramDef$values)))) {
          e <- paste0(e, "\"", name,"\" must be in")
          for (fact in paramDef$values)
            e <- paste0(e, " \"", fact, "\",")
          e <- paste(e, "but got", paramValue)
        }
      }
    } else {      # scalar == FALSE
      if (!inherits(paramValue, type))
        e <- paste0("vector of ", name, " must be of type ", type, ", but got ", class(paramValue), ".\n")
    }
  e
}

.h2o.transformParam <- function(paramDef, paramValue, collapseArrays = TRUE) {
  # Fetch mapping for given Java to R types
  mapping <- .type.map[paramDef$type,]
  type    <- mapping[1L, 1L]
  scalar  <- mapping[1L, 2L]
  name    <- paramDef$name
  if (scalar) { # scalar == TRUE
    if (inherits(paramValue, 'numeric') && paramValue ==  Inf) {
      paramValue <- "Infinity"
    } else if (inherits(paramValue, 'numeric') && paramValue == -Inf) {
      paramValue <- "-Infinity"
    }
  } else {      # scalar == FALSE
    if (inherits(paramValue, 'numeric')) {
        k = which(paramValue == Inf | paramValue == -Inf)
        if (length(k) > 0)
          for (n in k)
            if (paramValue[n] == Inf)
              paramValue[n] <- "Infinity"
            else
              paramValue[n] <- "-Infinity"
    }
    if (collapseArrays) {
      if(any(sapply(paramValue, function(x) !is.null(x) && is.H2OFrame(x))))
         paramValue <- lapply( paramValue, function(x) {
                            if (is.null(x)) NULL
                            else if (all(is.na(x))) NA
                            else paste0('"',h2o.getId(x),'"')
                          })
      if (paramDef$type == "string[][]"){
        paramValue <- .collapse.list.of.list.string(paramValue)
      } else if (type == "character")
        paramValue <- .collapse.char(paramValue)
      else if (paramDef$type == "StringPair[]")
        paramValue <- .collapse(sapply(paramValue, .collapse.tuple.string))
      else if (paramDef$type == "KeyValue[]") {
        f <- function(i) { .collapse.tuple.key_value(paramValue[i]) }
        paramValue <- .collapse(sapply(seq(length(paramValue)), f))
      } else
        paramValue <- .collapse(paramValue)
    }
  }
  if( is.H2OFrame(paramValue) )
    paramValue <- h2o.getId(paramValue)
  paramValue
}

.escape.string <- function(xi) { paste0("\"", xi, "\"") }

.collapse.tuple.string <- function(x) {
  .collapse.tuple(x, .escape.string)
}

.collapse.list.of.list.string <- function(x){
  parts <- c()
  for (i in x) {
    parts <- c(parts, paste0("[", paste0(i, collapse = ","), "]"))
  }
  paste0("[", paste0(parts, collapse = ","), "]")
}

.collapse.tuple.key_value <- function(x) {
  .collapse.tuple(list(
    key = .escape.string(names(x)),
    value = x[[1]]
  ), identity)
}

.collapse.tuple <- function(x, escape) {
  names <- names(x)
  if (is.null(names))
    names <- letters[1:length(x)]
  r <- c()
  for (i in 1:length(x)) {
    s <- paste0(names[i], ": ", escape(x[i]))
    r <- c(r, s)
  }
  paste0("{", paste0(r, collapse = ","), "}")
}

# Validate a given set of hyper parameters
# against algorithm definition.
# Transform all parameters in the same way as normal algorithm
# would do.
.h2o.checkAndUnifyHyperParameters <- function(algo, allParams, hyper_params, do_hyper_params_check) {

  errors <- lapply(allParams, function(paramDef) {
      e <- ""
      name <- paramDef$name
      hyper_names <- names(hyper_params)
      # First reject all non-gridable hyper parameters
      if (!paramDef$gridable && (name %in% hyper_names)) {
        e <- paste0("argument \"", name, "\" is not gridable\n")
      } else if (name %in% hyper_names) { # Check all specified hyper parameters
        # Hyper values for `name` parameter
        hyper_vals <- hyper_params[[name]]
        # Collect all possible verification errors
        if (do_hyper_params_check) {
          he <- lapply(hyper_vals, function(hv) {
                  # Transform all integer values to numeric
                  hv <- if (is.integer(hv)) as.numeric(hv) else hv
                  .h2o.checkParam(paramDef, hv)
                })
          e <- paste(he, collapse='')
        }
        # If there is no error then transform hyper values
        if (!nzchar(e)) {
          is_scalar <- .type.map[paramDef$type,][1L, 2L]
          transf_fce <- function(hv) {
                          # R does not treat integers as numeric
                          if (is.integer(hv)) {
                            hv <- as.numeric(hv)
                          }
                          mapping <- .type.map[paramDef$type,]
                          type <- mapping[1L, 1L]
                          # Note: we apply this transformatio also for types
                          # reported by the backend as scalar because of PUBDEV-1955
                          if (is.list(hv)) {
                            hv <- as.vector(hv, mode=type)
                          }
                          # Force evaluation of frames and fetch frame_id as
                          # a side effect
                          if (is.H2OFrame(hv) )
                            hv <- h2o.getId(hv)
                          .h2o.transformParam(paramDef, hv, collapseArrays = FALSE)
                        }
          transf_hyper_vals <- if (is_scalar) sapply(hyper_vals,transf_fce) else lapply(hyper_vals, transf_fce)
          hyper_params[[name]] <<- transf_hyper_vals
        }
      }
      e
  })

  if(any(nzchar(errors)))
    stop(errors)

  hyper_params
}

#' Predict on an H2O Model
#'
#' Obtains predictions from various fitted H2O model objects.
#'
#' This method dispatches on the type of H2O model to select the correct
#' prediction/scoring algorithm.
#' The order of the rows in the results is the same as the order in which the
#' data was loaded, even if some rows fail (for example, due to missing
#' values or unseen factor levels).
#'
#' @param object a fitted \linkS4class{H2OModel} object for which prediction is
#'        desired
#' @param newdata An H2OFrame object in which to look for
#'        variables with which to predict.
#' @param ... additional arguments to pass on.
#' @return Returns an H2OFrame object with probabilites and
#'         default predictions.
#' @seealso \code{\link{h2o.deeplearning}}, \code{\link{h2o.gbm}},
#'          \code{\link{h2o.glm}}, \code{\link{h2o.randomForest}} for model
#'          generation in h2o.
#' @examples 
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' 
#' f <- "https://s3.amazonaws.com/h2o-public-test-data/smalldata/glm_test/insurance.csv"
#' insurance <- h2o.importFile(f)
#' predictors <- colnames(insurance)[1:4]
#' response <- "Claims"
#' insurance['Group'] <- as.factor(insurance['Group'])
#' insurance['Age'] <- as.factor(insurance['Age'])
#' splits <- h2o.splitFrame(data =  insurance, ratios = 0.8, seed = 1234)
#' train <- splits[[1]]
#' valid <- splits[[2]]
#' insurance_gbm <- h2o.gbm(x = predictors, y = response, 
#'                          training_frame = train,
#'                          validation_frame = valid, 
#'                          distribution = "huber", 
#'                          huber_alpha = 0.9, seed = 1234)
#' h2o.predict(insurance_gbm, newdata = insurance)
#' }
#' @export
predict.H2OModel <- function(object, newdata, ...) {
  h2o.predict.H2OModel(object, newdata, ...)
}

#' Predict on an H2O Model
#'
#' @param object a fitted model object for which prediction is desired.
#' @param newdata An H2OFrame object in which to look for
#'        variables with which to predict.
#' @param ... additional arguments to pass on.
#' @return Returns an H2OFrame object with probabilites and
#'         default predictions.
#' @export
h2o.predict <- function(object, newdata, ...){
  UseMethod("h2o.predict", object)
}

#' Use H2O Transformation model and apply the underlying transformation
#'
#' @param model A trained model representing the transformation strategy
#' @param ... Transformation model-specific parameters
#' @return Returns an H2OFrame object with data transformed.
#' @export
setGeneric("h2o.transform", function(model, ...) {
  if(!is(model, "H2OModel")) {
    stop(paste("Argument 'model' must be an H2O Model. Received:", class(model)))
  }
  standardGeneric("h2o.transform")
})


#' Applies target encoding to a given dataset
#'
#' @param model A trained model representing the transformation strategy
#' @param data An H2OFrame with data to be transformed
#' @param blending Use blending during the transformation. Respects model settings when not set.
#' @param inflection_point Blending parameter. Only effective when blending is enabled.
#'  By default, model settings are respected, if not overridden by this setting.
#' @param smoothing Blending parameter. Only effective when blending is enabled.
#'  By default, model settings are respected, if not overridden by this setting.
#' @param noise An amount of random noise added to the encoding, this helps prevent overfitting.
#'  By default, model settings are respected, if not overridden by this setting.
#' @param as_training Must be set to True when encoding the training frame. Defaults to False.
#' @param ... Mainly used for backwards compatibility, to allow deprecated parameters.
#' @return Returns an H2OFrame object with data transformed.
#' @export
setMethod("h2o.transform", signature("H2OTargetEncoderModel"), function(model, data,
                                                                        blending = NULL,
                                                                        inflection_point = -1,
                                                                        smoothing = -1,
                                                                        noise = NULL,
                                                                        as_training = FALSE,
                                                                        ...) {
    varargs <- list(...)
    for (arg in names(varargs)) {
        if (arg %in% c('data_leakage_handling', 'seed')) {
            warning(paste0("argument '", arg, "' is deprecated and will be ignored; please define it instead on model creation using `h2o.targetencoder`."))
            argval <- varargs[[arg]]
            if (arg == 'data_leakage_handling' && argval != "None") {
                warning(paste0("Deprecated `data_leakage_handling=",argval,"` is replaced by `as_training=True`. ",
                        "Please update your code."))
                as_training <- TRUE
            }
        } else if (arg == 'use_blending') {
            warning("argument 'use_blending' is deprecated; please use 'blending' instead.")
            if (missing(blending)) blending <- varargs$use_blending else warning("ignoring 'use_blending' as 'blending' was also provided.")
        } else {
            stop(paste("unused argument", arg, "=", varargs[[arg]]))
        }
    }

    params <- list()
    params$model <- model@model_id
    params$frame <- h2o.getId(data)
    if (is.null(blending)){
        params$blending <- model@allparameters$blending
    } else {
        params$blending <- blending
    }
    if (params$blending) {
        params$inflection_point <- inflection_point
        params$smoothing <- smoothing
    }
    if (!is.null(noise)){
        params$noise <- noise
    }
    params$as_training <- as_training
    
    res <- .h2o.__remoteSend(
        "TargetEncoderTransform",
        method = "GET",
        h2oRestApiVersion = 3,.params = params
    )
  
    h2o.getFrame(res$name)
})

#'
#' Transform words (or sequences of words) to vectors using a word2vec model.
#'
#' @param model A word2vec model.
#' @param words An H2OFrame made of a single column containing source words.
#' @param aggregate_method Specifies how to aggregate sequences of words. If method is `NONE`
#'    then no aggregation is performed and each input word is mapped to a single word-vector.
#'    If method is 'AVERAGE' then input is treated as sequences of words delimited by NA.
#'    Each word of a sequences is internally mapped to a vector and vectors belonging to
#'    the same sentence are averaged and returned in the result.
#' @examples
#' \dontrun{
#' h2o.init()
#'
#' # Build a simple word2vec model
#' data <- as.character(as.h2o(c("a", "b", "a")))
#' w2v_model <- h2o.word2vec(data, sent_sample_rate = 0, min_word_freq = 0, epochs = 1, vec_size = 2)
#'
#' # Transform words to vectors without aggregation
#' sentences <- as.character(as.h2o(c("b", "c", "a", NA, "b")))
#' h2o.transform(w2v_model, sentences) # -> 5 rows total, 2 rows NA ("c" is not in the vocabulary)
#'
#' # Transform words to vectors and return average vector for each sentence
#' h2o.transform(w2v_model, sentences, aggregate_method = "AVERAGE") # -> 2 rows
#' }
#' @export
setMethod("h2o.transform", signature("H2OWordEmbeddingModel"), function(model, words, aggregate_method = c("NONE", "AVERAGE")) {
  
  if (!is(model, "H2OModel")) stop(paste("The argument 'model' must be a word2vec model. Received:", class(model)))
  if (missing(words)) stop("`words` must be specified")
  if (!is.H2OFrame(words)) stop("`words` must be an H2OFrame")
  if (ncol(words) != 1) stop("`words` frame must contain a single string column")
  
  if (length(aggregate_method) > 1)
    aggregate_method <- aggregate_method[1]
  
  res <- .h2o.__remoteSend(method="GET", "Word2VecTransform", model = model@model_id,
                           words_frame = h2o.getId(words), aggregate_method = aggregate_method)
  key <- res$vectors_frame$name
  h2o.getFrame(key)
  
})



#'
#' @rdname predict.H2OModel
#' @export
h2o.predict.H2OModel <- function(object, newdata, ...) {
  if (missing(newdata)) {
    stop("predictions with a missing `newdata` argument is not implemented yet")
  }

  # Send keys to create predictions
  url <- paste0('Predictions/models/', object@model_id, '/frames/',  h2o.getId(newdata))
  res <- .h2o.__remoteSend(url, method = "POST", h2oRestApiVersion = 4)
  job_key <- res$key$name
  dest_key <- res$dest$name
  .h2o.__waitOnJob(job_key)
  h2o.getFrame(dest_key)
}

#' Predict the Leaf Node Assignment on an H2O Model
#'
#' Obtains leaf node assignment from fitted H2O model objects.
#'
#' For every row in the test set, return the leaf placements of the row in all the trees in the model.
#' Placements can be represented either by paths to the leaf nodes from the tree root or by H2O's internal identifiers.
#' The order of the rows in the results is the same as the order in which the
#' data was loaded
#'
#' @param object a fitted \linkS4class{H2OModel} object for which prediction is
#'        desired
#' @param newdata An H2OFrame object in which to look for
#'        variables with which to predict.
#' @param type choice of either "Path" when tree paths are to be returned (default); or "Node_ID" when the output
#         should be the leaf node IDs.
#' @param ... additional arguments to pass on.
#' @return Returns an H2OFrame object with categorical leaf assignment identifiers for
#'         each tree in the model.
#' @seealso \code{\link{h2o.gbm}} and  \code{\link{h2o.randomForest}} for model
#'          generation in h2o.
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' prostate_path <- system.file("extdata", "prostate.csv", package = "h2o")
#' prostate <- h2o.uploadFile(path = prostate_path)
#' prostate$CAPSULE <- as.factor(prostate$CAPSULE)
#' prostate_gbm <- h2o.gbm(3:9, "CAPSULE", prostate)
#' h2o.predict(prostate_gbm, prostate)
#' h2o.predict_leaf_node_assignment(prostate_gbm, prostate)
#' }
#' @export
predict_leaf_node_assignment.H2OModel <- function(object, newdata, type = c("Path", "Node_ID"), ...) {
  if (missing(newdata)) {
    stop("predictions with a missing `newdata` argument is not implemented yet")
  }
  params <- list(leaf_node_assignment = TRUE)
  if (!missing(type)) {
    if (!(type %in% c("Path", "Node_ID"))) {
      stop("type must be one of: Path, Node_ID")
    }
    params$leaf_node_assignment_type <- type
  }

  url <- paste0('Predictions/models/', object@model_id, '/frames/',  h2o.getId(newdata))
  res <- .h2o.__remoteSend(url, method = "POST", .params = params)
  res <- res$predictions_frame
  h2o.getFrame(res$name)
}

#' @rdname predict_leaf_node_assignment.H2OModel
#' @export
h2o.predict_leaf_node_assignment <- predict_leaf_node_assignment.H2OModel

h2o.result <- function(model) {
  if (!is(model, "H2OModel")) stop("h2o.result can only be applied to H2OModel instances with constant results")
  return(as.data.frame(.newExpr("result", model@model_id)))
}

h2o.crossValidate <- function(model, nfolds, model.type = c("gbm", "glm", "deeplearning"), params, strategy = c("mod1", "random")) {
  output <- data.frame()

  if( nfolds < 2 ) stop("`nfolds` must be greater than or equal to 2")
  if( missing(model) & missing(model.type) ) stop("must declare `model` or `model.type`")
  else if( missing(model) )
  {
    if(model.type == "gbm") model.type = "h2o.gbm"
    else if(model.type == "glm") model.type = "h2o.glm"
    else if(model.type == "deeplearning") model.type = "h2o.deeplearning"

    model <- do.call(model.type, c(params))
  }
  output[1, "fold_num"] <- -1
  output[1, "model_key"] <- model@model_id
  # output[1, "model"] <- model@model$mse_valid

  data <- params$training_frame
  data <- eval(data)
  data.len <- nrow(data)

  # nfold_vec <- h2o.sample(fr, 1:nfolds)
  nfold_vec <- sample(rep(1:nfolds, length.out = data.len), data.len)

  fnum_id <- as.h2o(nfold_vec)
  fnum_id <- h2o.cbind(fnum_id, data)

  xval <- lapply(1:nfolds, function(i) {
      params$training_frame   <- data[fnum_id[,1] != i, ]
      params$validation_frame <- data[fnum_id[,1] == i, ]
      fold <- do.call(model.type, c(params))
      output[(i+1), "fold_num"] <<- i - 1
      output[(i+1), "model_key"] <<- fold@model_id
      # output[(i+1), "cv_err"] <<- mean(as.vector(fold@model$mse_valid))
      fold
    })

  model
}

#' Predict class probabilities at each stage of an H2O Model
#'
#' The output structure is analogous to the output of \link{h2o.predict_leaf_node_assignment}. For each tree t and
#' class c there will be a column Tt.Cc (eg. T3.C1 for tree 3 and class 1). The value will be the corresponding
#' predicted probability of this class by combining the raw contributions of trees T1.Cc,..,TtCc. Binomial models build
#' the trees just for the first class and values in columns Tx.C1 thus correspond to the the probability p0.
#'
#' @param object a fitted \linkS4class{H2OModel} object for which prediction is
#'        desired
#' @param newdata An H2OFrame object in which to look for
#'        variables with which to predict.
#' @param ... additional arguments to pass on.
#' @return Returns an H2OFrame object with predicted probability for each tree in the model.
#' @seealso \code{\link{h2o.gbm}} and  \code{\link{h2o.randomForest}} for model
#'          generation in h2o.
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' prostate_path <- system.file("extdata", "prostate.csv", package = "h2o")
#' prostate <- h2o.uploadFile(path = prostate_path)
#' prostate$CAPSULE <- as.factor(prostate$CAPSULE)
#' prostate_gbm <- h2o.gbm(3:9, "CAPSULE", prostate)
#' h2o.predict(prostate_gbm, prostate)
#' h2o.staged_predict_proba(prostate_gbm, prostate)
#' }
#' @export
staged_predict_proba.H2OModel <- function(object, newdata, ...) {
  if (missing(newdata)) {
    stop("predictions with a missing `newdata` argument is not implemented yet")
  }

  url <- paste0('Predictions/models/', object@model_id, '/frames/',  h2o.getId(newdata))
  res <- .h2o.__remoteSend(url, method = "POST", predict_staged_proba=TRUE)
  res <- res$predictions_frame
  h2o.getFrame(res$name)
}

#' @rdname staged_predict_proba.H2OModel
#' @export
h2o.staged_predict_proba <- staged_predict_proba.H2OModel

#' Predict feature contributions - SHAP values on an H2O Model (only DRF, GBM, XGBoost models and equivalent imported MOJOs).
#'
#' Default implemntation return H2OFrame shape (#rows, #features + 1) - there is a feature contribution column for each input
#' feature, the last column is the model bias (same value for each row). The sum of the feature contributions
#' and the bias term is equal to the raw prediction of the model. Raw prediction of tree-based model is the sum
#' of the predictions of the individual trees before the inverse link function is applied to get the actual
#' prediction. For Gaussian distribution the sum of the contributions is equal to the model prediction.
#'
#' Note: Multinomial classification models are currently not supported.
#'
#' @param object a fitted \linkS4class{H2OModel} object for which prediction is
#'        desired
#' @param newdata An H2OFrame object in which to look for
#'        variables with which to predict.
#' @param output_format Specify how to output feature contributions in XGBoost - XGBoost by default outputs
#'                      contributions for 1-hot encoded features, specifying a compact output format will produce
#'                      a per-feature contribution. Defaults to original.
#' @param top_n Return only #top_n highest contributions + bias
#'              If top_n<0 then sort all SHAP values in descending order
#'              If top_n<0 && bottom_n<0 then sort all SHAP values in descending order
#' @param bottom_n Return only #bottom_n lowest contributions + bias
#'                 If top_n and bottom_n are defined together then return array of #top_n + #bottom_n + bias
#'                 If bottom_n<0 then sort all SHAP values in ascending order
#'                 If top_n<0 && bottom_n<0 then sort all SHAP values in descending order
#' @param compare_abs True to compare absolute values of contributions
#' @param ... additional arguments to pass on.
#' @return Returns an H2OFrame contain feature contributions for each input row.
#' @seealso \code{\link{h2o.gbm}} and  \code{\link{h2o.randomForest}} for model
#'          generation in h2o.
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' prostate_path <- system.file("extdata", "prostate.csv", package = "h2o")
#' prostate <- h2o.uploadFile(path = prostate_path)
#' prostate_gbm <- h2o.gbm(3:9, "AGE", prostate)
#' h2o.predict(prostate_gbm, prostate)
#' # Compute SHAP
#' h2o.predict_contributions(prostate_gbm, prostate)
#' # Compute SHAP and pick the top two highest
#' h2o.predict_contributions(prostate_gbm, prostate, top_n=2)
#' # Compute SHAP and pick the top two lowest
#' h2o.predict_contributions(prostate_gbm, prostate, bottom_n=2)
#' # Compute SHAP and pick the top two highest regardless of the sign
#' h2o.predict_contributions(prostate_gbm, prostate, top_n=2, compare_abs=TRUE)
#' # Compute SHAP and pick the top two lowest regardless of the sign
#' h2o.predict_contributions(prostate_gbm, prostate, bottom_n=2, compare_abs=TRUE)
#' # Compute SHAP values and show them all in descending order
#' h2o.predict_contributions(prostate_gbm, prostate, top_n=-1)
#' # Compute SHAP and pick the top two highest and top two lowest
#' h2o.predict_contributions(prostate_gbm, prostate, top_n=2, bottom_n=2)
#' }
#' @export
predict_contributions.H2OModel <- function(object, newdata, output_format = c("original", "compact"), top_n=0, bottom_n=0, compare_abs=FALSE, ...) {
    if (missing(newdata)) {
        stop("predictions with a missing `newdata` argument is not implemented yet")
    }
    params <- list(predict_contributions = TRUE, top_n=top_n, bottom_n=bottom_n, compare_abs=compare_abs)
    params$predict_contributions_output_format <- match.arg(output_format)
    url <- paste0('Predictions/models/', object@model_id, '/frames/',  h2o.getId(newdata))
    res <- .h2o.__remoteSend(url, method = "POST", .params = params, h2oRestApiVersion = 4)
    job_key <- res$key$name
    dest_key <- res$dest$name
    .h2o.__waitOnJob(job_key)
    h2o.getFrame(dest_key)
}

#' @rdname predict_contributions.H2OModel
#' @export
h2o.predict_contributions <- predict_contributions.H2OModel

#' Retrieve the number of occurrences of each feature for given observations 
#  on their respective paths in a tree ensemble model.
#' Available for GBM, Random Forest and Isolation Forest models.
#'
#' @param object a fitted \linkS4class{H2OModel} object for which prediction is
#'        desired
#' @param newdata An H2OFrame object in which to look for
#'        variables with which to predict.
#' @param ... additional arguments to pass on.
#' @return Returns an H2OFrame contain per-feature frequencies on the predict path for each input row.
#' @seealso \code{\link{h2o.gbm}} and  \code{\link{h2o.randomForest}} for model
#'          generation in h2o.
feature_frequencies.H2OModel <- function(object, newdata, ...) {
    if (missing(newdata)) {
        stop("predictions with a missing `newdata` argument is not implemented yet")
    }

    url <- paste0('Predictions/models/', object@model_id, '/frames/',  h2o.getId(newdata))
    res <- .h2o.__remoteSend(url, method = "POST", feature_frequencies=TRUE)
    res <- res$predictions_frame
    h2o.getFrame(res$name)
}

#' @rdname feature_frequencies.H2OModel
#' @export
h2o.feature_frequencies <- feature_frequencies.H2OModel


#' Model Performance Metrics in H2O
#'
#' Given a trained h2o model, compute its performance on the given
#' dataset.  However, if the dataset does not contain the response/target column, no performance will be returned.
#' Instead, a warning message will be printed.
#'
#'
#' @param model An \linkS4class{H2OModel} object
#' @param newdata An H2OFrame. The model will make predictions
#'        on this dataset, and subsequently score them. The dataset should
#'        match the dataset that was used to train the model, in terms of
#'        column names, types, and dimensions. If newdata is passed in, then train, valid, and xval are ignored.
#' @param train A logical value indicating whether to return the training metrics (constructed during training).
#'
#' Note: when the trained h2o model uses balance_classes, the training metrics constructed during training will be from the balanced training dataset.
#' For more information visit: \url{https://0xdata.atlassian.net/browse/TN-9}
#' @param valid A logical value indicating whether to return the validation metrics (constructed during training).
#' @param xval A logical value indicating whether to return the cross-validation metrics (constructed during training).
#' @param data (DEPRECATED) An H2OFrame. This argument is now called `newdata`.
#' @param auc_type For multinomila model only. Set default multinomial AUC type. Must be one of: "AUTO", "NONE", "MACRO_OVR", "WEIGHTED_OVR", "MACRO_OVO",
#'        "WEIGHTED_OVO". Default is "NONE"
#' @return Returns an object of the \linkS4class{H2OModelMetrics} subclass.
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' prostate_path <- system.file("extdata", "prostate.csv", package = "h2o")
#' prostate <- h2o.uploadFile(path = prostate_path)
#' prostate$CAPSULE <- as.factor(prostate$CAPSULE)
#' prostate_gbm <- h2o.gbm(3:9, "CAPSULE", prostate)
#' h2o.performance(model = prostate_gbm, newdata=prostate)
#'
#' ## If model uses balance_classes
#' ## the results from train = TRUE will not match the results from newdata = prostate
#' prostate_gbm_balanced <- h2o.gbm(3:9, "CAPSULE", prostate, balance_classes = TRUE)
#' h2o.performance(model = prostate_gbm_balanced, newdata = prostate)
#' h2o.performance(model = prostate_gbm_balanced, train = TRUE)
#' }
#' @export
h2o.performance <- function(model, newdata=NULL, train=FALSE, valid=FALSE, xval=FALSE, data=NULL, auc_type="NONE") {

  # data is now deprecated and the new arg name is newdata
  if (!is.null(data)) {
    warning("The `data` argument is DEPRECATED; use `newdata` instead as `data` will eventually be removed")
    if (is.null(newdata)) newdata <- data
    else stop("Do not use both `data` and `newdata`; just use `newdata`")
  }

  # Some parameter checking
  if(!is(model, "H2OModel")) stop("`model` must an H2OModel object")
  if(!is.null(newdata) && !is.H2OFrame(newdata)) stop("`newdata` must be an H2OFrame object")
  if(!is.logical(train) || length(train) != 1L || is.na(train)) stop("`train` must be TRUE or FALSE")
  if(!is.logical(valid) || length(valid) != 1L || is.na(valid)) stop("`valid` must be TRUE or FALSE")
  if(!is.logical(xval) || length(xval) != 1L || is.na(xval)) stop("`xval` must be TRUE or FALSE")
  if(sum(valid, xval, train) > 1) stop("only one of `train`, `valid`, and `xval` can be TRUE")
  if(!(auc_type %in% c("AUTO", "NONE", "MACRO_OVR", "WEIGHTED_OVR", "MACRO_OVO", "WEIGHTED_OVO"))) stop("`auc_type` must be \"AUTO\", \"NONE\", \"MACRO_OVR\", \"WEIGHTED_OVR\", \"MACRO_OVO\", or \"WEIGHTED_OVO\".")

  missingNewdata <- missing(newdata) || is.null(newdata)
  if( missingNewdata && auc_type != "NONE") {
    print("WARNING: The `auc_type` parameter is set but it is not used because the `newdata` parameter is NULL.")
  }
  if( !missingNewdata ) {
    if (!is.null(model@parameters$y)  &&  !(model@parameters$y %in% names(newdata))) {
      print("WARNING: Model metrics cannot be calculated and metric_json is empty due to the absence of the response column in your dataset.")
      return(NULL)
    }
    newdata.id <- h2o.getId(newdata)
    parms <- list()
    parms[["model"]] <- model@model_id
    parms[["frame"]] <- newdata.id
    if(auc_type != "NONE"){
        parms[["auc_type"]] <- auc_type 
    } else if(!is.null(model@parameters$auc_type) && model@parameters$auc_type != "NONE"){
        parms[["auc_type"]] <- model@parameters$auc_type
    }
    res <- .h2o.__remoteSend(method = "POST", .h2o.__MODEL_METRICS(model@model_id, newdata.id), .params = parms)

    ####
    # FIXME need to do the client-side filtering...  PUBDEV-874:   https://0xdata.atlassian.net/browse/PUBDEV-874
    model_metrics <- Filter(function(mm) { mm$frame$name==newdata.id}, res$model_metrics)[[1]]   # filter on newdata.id, R's builtin Filter function
    #
    ####
    metrics <- model_metrics[!(names(model_metrics) %in% c("__meta", "names", "domains", "model_category"))]
    model_category <- model_metrics$model_category
    Class <- paste0("H2O", model_category, "Metrics")
    metrics$frame <- list()
    metrics$frame$name <- newdata.id
    new(Class     = Class,
        algorithm = model@algorithm,
        on_train  = missingNewdata,
        metrics   = metrics)
  }
  else if( train || (!train && !valid && !xval) ) return(model@model$training_metrics)    # no newdata, train, valid, and xval are false (all defaults), return the training metrics
  else if( valid ) {
    if( is.null(model@model$validation_metrics@metrics) ) return(NULL) # no newdata, but valid is true, return the validation metrics
    else                                                  return(model@model$validation_metrics)
  }
  else { #if xval
    if( is.null(model@model$cross_validation_metrics@metrics) ) return(NULL) # no newdata, but xval is true, return the crosss_validation metrics
    else                                                        return(model@model$cross_validation_metrics)
  }
}

#' Create Model Metrics from predicted and actual values in H2O
#'
#' Given predicted values (target for regression, class-1 probabilities or binomial
#' or per-class probabilities for multinomial), compute a model metrics object
#'
#' @param predicted An H2OFrame containing predictions
#' @param actuals An H2OFrame containing actual values
#' @param domain Vector with response factors for classification.
#' @param distribution Distribution for regression.
#' @param weights (optional) An H2OFrame containing observation weights.
#' @param treatment (optional, for uplift models only) An H2OFrame containing treatment column for uplift classification.
#' @param auc_type (optional) For multinomial classification you have to specify which type of agregated AUC/AUCPR will be used to calculate this metric. 
#         Possibilities are MACRO_OVO, MACRO_OVR, WEIGHTED_OVO, WEIGHTED_OVR (OVO = One vs. One, OVR = One vs. Rest)
#' @param auuc_type (optional) For uplift binomial classification you have to specify which type of AUUC will be used to 
#'        calculate this metric. Possibilities are gini, lift, gain, AUTO. Default is AUTO which means qini.
#' @param auuc_nbins (optional) For uplift binomial classification you have to specify number of bins to be used 
#'        for calculation the AUUC. Default is -1, which means 1000.
#' @return Returns an object of the \linkS4class{H2OModelMetrics} subclass.
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' prostate_path <- system.file("extdata", "prostate.csv", package = "h2o")
#' prostate <- h2o.uploadFile(path = prostate_path)
#' prostate$CAPSULE <- as.factor(prostate$CAPSULE)
#' prostate_gbm <- h2o.gbm(3:9, "CAPSULE", prostate)
#' pred <- h2o.predict(prostate_gbm, prostate)[, 3] ## class-1 probability
#' h2o.make_metrics(pred, prostate$CAPSULE)
#' }
#' @export
h2o.make_metrics <- function(predicted, actuals, domain=NULL, distribution=NULL, weights=NULL, treatment=NULL, 
                                auc_type="NONE", auuc_type="AUTO", auuc_nbins=-1) {
  predicted <- .validate.H2OFrame(predicted, required=TRUE)
  actuals <- .validate.H2OFrame(actuals, required=TRUE)
  weights <- .validate.H2OFrame(weights, required=FALSE)
  treatment <- .validate.H2OFrame(treatment, required=FALSE)
  if (!is.character(auc_type)) stop("auc_type argument must be of type character")
  if (!(auc_type %in% c("MACRO_OVO", "MACRO_OVR", "WEIGHTED_OVO", "WEIGHTED_OVR", "NONE", "AUTO"))) {
    stop("auc_type argument must be MACRO_OVO, MACRO_OVR, WEIGHTED_OVO, WEIGHTED_OVR, NONE, AUTO")
  }
  params <- list()
  params$predictions_frame <- h2o.getId(predicted)
  params$actuals_frame <- h2o.getId(actuals)
  if (!is.null(weights)) {
    params$weights_frame <- h2o.getId(weights)
  }
  if (!is.null(treatment)) {
    params$treatment_frame <- h2o.getId(treatment)
      if (!(auuc_type %in% c("qini", "lift", "gain", "AUTO"))) {
        stop("auuc_type argument must be gini, lift, gain or AUTO")
      }
      if (auuc_nbins < -1 || auuc_nbins == 0) {
        stop("auuc_nbins must be -1 or higher than 0.")
      }
      params$auuc_type = auuc_type
      params$auuc_nbins = auuc_nbins
  }
  params$domain <- domain
  params$distribution <- distribution

  if (is.null(domain) && !is.null(h2o.levels(actuals)))
    domain <- h2o.levels(actuals)

  ## pythonify the domain
  if (!is.null(domain)) {
    out <- paste0('["',domain[1],'"')
    for (d in 2:length(domain)) {
      out <- paste0(out,',"',domain[d],'"')
    }
    out <- paste0(out, "]")
    params[["domain"]] <- out
  }
  params["auc_type"] <- auc_type  
  url <- paste0("ModelMetrics/predictions_frame/",params$predictions_frame,"/actuals_frame/",params$actuals_frame)
  res <- .h2o.__remoteSend(method = "POST", url, .params = params)
  model_metrics <- res$model_metrics
  metrics <- model_metrics[!(names(model_metrics) %in% c("__meta", "names", "domains", "model_category"))]
  name <- "H2ORegressionMetrics"
  if (!is.null(metrics$auuc_table)) name <- "H2OBinomialUpliftMetrics"
  else if (!is.null(metrics$AUC) && is.null(metrics$hit_ratio_table)) name <- "H2OBinomialMetrics"
  else if (!is.null(distribution) && distribution == "ordinal") name <- "H2OOrdinalMetrics"
  else if (!is.null(metrics$hit_ratio_table)) name <- "H2OMultinomialMetrics"
  new(Class = name, metrics = metrics)
}

#' Retrieve the AUC
#'
#' Retrieves the AUC value from an \linkS4class{H2OBinomialMetrics}.
#' If "train", "valid", and "xval" parameters are FALSE (default), then the training AUC value is returned. If more
#' than one parameter is set to TRUE, then a named vector of AUCs are returned, where the names are "train", "valid"
#' or "xval".
#'
#' @param object An \linkS4class{H2OBinomialMetrics} or \linkS4class{H2OMultinomialMetrics} object.
#' @param train Retrieve the training AUC
#' @param valid Retrieve the validation AUC
#' @param xval Retrieve the cross-validation AUC
#' @seealso \code{\link{h2o.giniCoef}} for the Gini coefficient,
#'          \code{\link{h2o.mse}} for MSE, and \code{\link{h2o.metric}} for the
#'          various threshold metrics. See \code{\link{h2o.performance}} for
#'          creating H2OModelMetrics objects.
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#'
#' prostate_path <- system.file("extdata", "prostate.csv", package = "h2o")
#' prostate <- h2o.uploadFile(prostate_path)
#'
#' prostate[, 2] <- as.factor(prostate[, 2])
#' model <- h2o.gbm(x = 3:9, y = 2, training_frame = prostate, distribution = "bernoulli")
#' perf <- h2o.performance(model, prostate)
#' h2o.auc(perf)
#' }
#' @export
h2o.auc <- function(object, train=FALSE, valid=FALSE, xval=FALSE) {
  if( is(object, "H2OModelMetrics") ) return( object@metrics$AUC )
  if( is(object, "H2OModel") ) {
    model.parts <- .model.parts(object)
    if ( !train && !valid && !xval ) {
      metric <- model.parts$tm@metrics$AUC
      if ( !is.null(metric) ) return(metric)
    }
    v <- c()
    v_names <- c()
    if ( train ) {
      v <- c(v,model.parts$tm@metrics$AUC)
      v_names <- c(v_names,"train")
    }
    if ( valid ) {
      if( is.null(model.parts$vm) ) return(invisible(.warn.no.validation()))
      else {
        v <- c(v,model.parts$vm@metrics$AUC)
        v_names <- c(v_names,"valid")
      }
    }
    if ( xval ) {
      if( is.null(model.parts$xm) ) return(invisible(.warn.no.cross.validation()))
      else {
        v <- c(v,model.parts$xm@metrics$AUC)
        v_names <- c(v_names,"xval")
      }
    }
    if ( !is.null(v) ) {
      names(v) <- v_names
      if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
    }
  }
  warning(paste0("No AUC for ", class(object)))
  invisible(NULL)
}

#' Retrieve the default AUUC
#'
#' Retrieves the AUUC value from an \linkS4class{H2OBinomialUpliftMetrics}. If the metric parameter is "AUTO", 
#' the type of AUUC depends on auuc_type which was set before training. If you need specific AUUC, set metric parameter.
#' If "train" and "valid" parameters are FALSE (default), then the training AUUC value is returned. If more
#' than one parameter is set to TRUE, then a named vector of AUUCs are returned, where the names are "train", "valid".
#'
#' @param object An \linkS4class{H2OBinomialUpliftMetrics}
#' @param train Retrieve the training AUUC
#' @param valid Retrieve the validation AUUC
#' @param metric Specify the AUUC metric to get specific AUUC. Possibilities are NULL, "qini", "lift", "gain".
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' f <- "https://s3.amazonaws.com/h2o-public-test-data/smalldata/uplift/criteo_uplift_13k.csv"
#' train <- h2o.importFile(f)
#' train$treatment <- as.factor(train$treatment)
#' train$conversion <- as.factor(train$conversion)
#' 
#' model <- h2o.upliftRandomForest(training_frame=train, x=sprintf("f%s",seq(0:10)), y="conversion",
#'                                 ntrees=10, max_depth=5, treatment_column="treatment", 
#'                                 auuc_type="AUTO")
#' perf <- h2o.performance(model, train=TRUE) 
#' h2o.auuc(perf)
#' }
#' @export
h2o.auuc <- function(object, train=FALSE, valid=FALSE, metric=NULL) {
    if(!is.null(metric) && !metric %in% c("qini", "lift", "gain")) 
        stop("metric must be NULL, 'qini', 'lift' or 'gain'")
    if( is(object, "H2OModelMetrics") ) {
        if(is.null(metric)) { 
            return( object@metrics$AUUC )
        } else {
            return( eval(parse(text=paste("object@metrics$auuc_table$", metric,"[1]", sep=""))))
        }
    }
    if( is(object, "H2OModel") ) {
        model.parts <- .model.parts(object)
        if ( !train && !valid ) {
            if (is.null(metric)) { 
                mm <- model.parts$tm@metrics$AUUC
            } else {
                mm <- eval(parse(text=paste("model.parts$tm@metrics$auuc_table$", metric,"[1]", sep="")))
            }
            if ( !is.null(mm) ) return(mm)
        }
        v <- c()
        v_names <- c()
        if ( train ) {
            if (is.null(metric)) { 
                mm <- model.parts$tm@metrics$AUUC
            } else {
                mm <- eval(parse(text=paste("model.parts$tm@metrics$auuc_table$", metric,"[1]", sep="")))
            }
            v <- c(v, mm)
            v_names <- c(v_names,"train")
        }
        if ( valid ) {
            if( is.null(model.parts$vm) ) return(invisible(.warn.no.validation()))
            else {
                if (is.null(metric)) { 
                    mm <- model.parts$vm@metrics$AUUC
                } else {
                    mm <- eval(parse(text=paste("model.parts$vm@metrics$auuc_table$", metric,"[1]", sep="")))
                }
                v <- c(v, mm)
                v_names <- c(v_names,"valid")
            }
        }
        if ( !is.null(v) ) {
            names(v) <- v_names
            if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
        }
    }
    warning(paste0("No AUUC for ", class(object)))
    invisible(NULL)
}

#' Retrieve the all types of AUUC in a table
#'
#' Retrieves the all types of AUUC in a table from an \linkS4class{H2OBinomialUpliftMetrics}.
#' If "train" and "valid" parameters are FALSE (default), then the training AUUC values are returned. If more
#' than one parameter is set to TRUE, then a named vector of AUUCs are returned, where the names are "train", "valid".
#'
#' @param object An \linkS4class{H2OBinomialUpliftMetrics}
#' @param train Retrieve the training AUUC table
#' @param valid Retrieve the validation AUUC table
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' f <- "https://s3.amazonaws.com/h2o-public-test-data/smalldata/uplift/criteo_uplift_13k.csv"
#' train <- h2o.importFile(f)
#' train$treatment <- as.factor(train$treatment)
#' train$conversion <- as.factor(train$conversion)
#' 
#' model <- h2o.upliftRandomForest(training_frame=train, x=sprintf("f%s",seq(0:10)), y="conversion",
#'                                        ntrees=10, max_depth=5, treatment_column="treatment", 
#'                                        auuc_type="AUTO")
#' perf <- h2o.performance(model, train=TRUE) 
#' h2o.auuc_table(perf)
#' }
#' @export
h2o.auuc_table <- function(object, train=FALSE, valid=FALSE) {
    if( is(object, "H2OModelMetrics") ) return( object@metrics$auuc_table )
    if( is(object, "H2OModel") ) {
        model.parts <- .model.parts(object)
        if ( !train && !valid ) {
            metric <- model.parts$tm@metrics$auuc_table
            if ( !is.null(metric) ) return(metric)
        }
        v <- c()
        v_names <- c()
        if ( train ) {
            v <- c(v,model.parts$tm@metrics$auuc_table)
            v_names <- c(v_names,"train")
        }
        if ( valid ) {
            if( is.null(model.parts$vm) ) return(invisible(.warn.no.validation()))
            else {
                v <- c(v,model.parts$vm@metrics$auuc_table)
                v_names <- c(v_names,"valid")
            }
        }
        if ( !is.null(v) ) {
            names(v) <- v_names
            if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
        }
    }
    warning(paste0("No AUUC table for ", class(object)))
    invisible(NULL)
}

#' Retrieve the thresholds and metric scores table
#'
#' Retrieves the thresholds and metric scores table from an \linkS4class{H2OBinomialUpliftMetrics}.
#' The table contains indices, thresholds, all cumulative uplift values and cumulative number of observations.
#' If "train" and "valid" parameters are FALSE (default), then the training table is returned. If more
#' than one parameter is set to TRUE, then a named vector of tables is returned, where the names are "train", "valid".
#'
#' @param object An \linkS4class{H2OBinomialUpliftMetrics}
#' @param train Retrieve the training thresholds and metric scores table
#' @param valid Retrieve the validation thresholds and metric scores table
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' f <- "https://s3.amazonaws.com/h2o-public-test-data/smalldata/uplift/criteo_uplift_13k.csv"
#' train <- h2o.importFile(f)
#' train$treatment <- as.factor(train$treatment)
#' train$conversion <- as.factor(train$conversion)
#' 
#' model <- h2o.upliftRandomForest(training_frame=train, x=sprintf("f%s",seq(0:10)), y="conversion",
#'                                 ntrees=10, max_depth=5, treatment_column="treatment", 
#'                                 auuc_type="AUTO")
#' perf <- h2o.performance(model, train=TRUE) 
#' h2o.thresholds_and_metric_scores(perf)
#' }
#' @export
h2o.thresholds_and_metric_scores <- function(object, train=FALSE, valid=FALSE) {
    if( is(object, "H2OModelMetrics") ) return( object@metrics$thresholds_and_metric_score)
    if( is(object, "H2OModel") ) {
        model.parts <- .model.parts(object)
        if ( !train && !valid ) {
            metric <- model.parts$tm@metrics$thresholds_and_metric_score
            if ( !is.null(metric) ) return(metric)
        }
        v <- c()
        v_names <- c()
        if ( train ) {
            v <- c(v,model.parts$tm@metrics$thresholds_and_metric_score)
            v_names <- c(v_names,"train")
        }
        if ( valid ) {
            if( is.null(model.parts$vm) ) return(invisible(.warn.no.validation()))
            else {
                v <- c(v,model.parts$vm@metrics$thresholds_and_metric_score)
                v_names <- c(v_names,"valid")
            }
        }
        if ( !is.null(v) ) {
            names(v) <- v_names
            if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
        }
    }
    warning(paste0("No thresholds_and_metric_score table for ", class(object)))
    invisible(NULL)
}

#' Retrieve the default Qini value
#'
#' Retrieves the Qini value from an \linkS4class{H2OBinomialUpliftMetrics}.
#' If "train" and "valid" parameters are FALSE (default), then the training Qini value is returned. If more
#' than one parameter is set to TRUE, then a named vector of Qini values are returned, where the names are "train", "valid".
#'
#' @param object An \linkS4class{H2OBinomialUpliftMetrics} or 
#' @param train Retrieve the training Qini value
#' @param valid Retrieve the validation Qini
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' f <- "https://s3.amazonaws.com/h2o-public-test-data/smalldata/uplift/criteo_uplift_13k.csv"
#' train <- h2o.importFile(f)
#' train$treatment <- as.factor(train$treatment)
#' train$conversion <- as.factor(train$conversion)
#' 
#' model <- h2o.upliftRandomForest(training_frame=train, x=sprintf("f%s",seq(0:10)), y="conversion",
#'                                 ntrees=10, max_depth=5, treatment_column="treatment",
#'                                 auuc_type="AUTO")
#' perf <- h2o.performance(model, train=TRUE) 
#' h2o.qini(perf)
#' }
#' @export
h2o.qini <- function(object, train=FALSE, valid=FALSE) {
    if( is(object, "H2OModelMetrics") ) return( object@metrics$qini )
    if( is(object, "H2OModel") ) {
        model.parts <- .model.parts(object)
        if ( !train && !valid ) {
            metric <- model.parts$tm@metrics$qini
            if ( !is.null(metric) ) return(metric)
        }
        v <- c()
        v_names <- c()
        if ( train ) {
            v <- c(v,model.parts$tm@metrics$qini)
            v_names <- c(v_names,"train")
        }
        if ( valid ) {
            if( is.null(model.parts$vm) ) return(invisible(.warn.no.validation()))
            else {
                v <- c(v,model.parts$vm@metrics$qini)
                v_names <- c(v_names,"valid")
            }
        }
        if ( !is.null(v) ) {
            names(v) <- v_names
            if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
        }
    }
    warning(paste0("No Qini value for ", class(object)))
    invisible(NULL)
}

#' Retrieve the default AECU (Average Excess Cumulative Uplift = area between AUUC and random AUUC)
#'
#' Retrieves the AECU value from an \linkS4class{H2OBinomialUpliftMetrics}. You need to specificy the type of AECU
#' using metric parameter. Defaults "qini". Qini AECU equals the Qini value.
#' If "train" and "valid" parameters are FALSE (default), then the training AECU value is returned. If more
#' than one parameter is set to TRUE, then a named vector of AECUs are returned, where the names are "train", "valid".
#'
#' @param object An \linkS4class{H2OBinomialUpliftMetrics}
#' @param train Retrieve the training AECU
#' @param valid Retrieve the validation AECU
#' @param metric Specify metric of AECU. Posibilities are "qini", "lift", "gain", defaults "qini".
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' f <- "https://s3.amazonaws.com/h2o-public-test-data/smalldata/uplift/criteo_uplift_13k.csv"
#' train <- h2o.importFile(f)
#' train$treatment <- as.factor(train$treatment)
#' train$conversion <- as.factor(train$conversion)
#' 
#' model <- h2o.upliftRandomForest(training_frame=train, x=sprintf("f%s",seq(0:10)), y="conversion",
#'                                 ntrees=10, max_depth=5, treatment_column="treatment",
#'                                 auuc_type="AUTO")
#' perf <- h2o.performance(model, train=TRUE) 
#' h2o.aecu(perf)
#' }
#' @export
h2o.aecu <- function(object, train=FALSE, valid=FALSE, metric="qini") {
    if(!metric %in% c("qini", "lift", "gain")) stop("metric must be 'qini', 'lift' or 'gain'")
    if( is(object, "H2OModelMetrics") ) {
        return( eval(parse(text=paste("object@metrics$aecu_table$", metric,"[1]", sep=""))))
    }
    if( is(object, "H2OModel") ) {
        model.parts <- .model.parts(object)
        if ( !train && !valid ) {
            mm <- eval(parse(text=paste("model.parts$tm@metrics$aecu_table$", metric,"[1]", sep="")))
            if ( !is.null(mm) ) return(mm)
        }
        v <- c()
        v_names <- c()
        if ( train ) {
            mm <- eval(parse(text=paste("model.parts$tm@metrics$aecu_table$", metric,"[1]", sep="")))
            v <- c(v, mm)
            v_names <- c(v_names,"train")
        }
        if ( valid ) {
            if( is.null(model.parts$vm) ) return(invisible(.warn.no.validation()))
            else {
                mm <- eval(parse(text=paste("model.parts$vm@metrics$auuc_table$", metric,"[1]", sep="")))
                v <- c(v, mm)
                v_names <- c(v_names,"valid")
            }
        }
        if ( !is.null(v) ) {
            names(v) <- v_names
            if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
        }
    }
    warning(paste0("No AECU for ", class(object)))
    invisible(NULL)
}

#' Retrieve the all types of AECU (average excess cumulative uplift) value in a table
#'
#' Retrieves the all types of AECU value in a table from an \linkS4class{H2OBinomialUpliftMetrics}.
#' If "train" and "valid" parameters are FALSE (default), then the training AECU values are returned. If more
#' than one parameter is set to TRUE, then a named vector of AECU values are returned, where the names are "train", "valid".
#'
#' @param object An \linkS4class{H2OBinomialUpliftMetrics}
#' @param train Retrieve the training AECU values table
#' @param valid Retrieve the validation AECU values table
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' f <- "https://s3.amazonaws.com/h2o-public-test-data/smalldata/uplift/criteo_uplift_13k.csv"
#' train <- h2o.importFile(f)
#' train$treatment <- as.factor(train$treatment)
#' train$conversion <- as.factor(train$conversion)
#' 
#' model <- h2o.upliftRandomForest(training_frame=train, x=sprintf("f%s",seq(0:10)), y="conversion",
#'                                 ntrees=10, max_depth=5, treatment_column="treatment",
#'                                 auuc_type="AUTO")
#' perf <- h2o.performance(model, train=TRUE) 
#' h2o.aecu_table(perf)
#' }
#' @export
h2o.aecu_table <- function(object, train=FALSE, valid=FALSE) {
    if( is(object, "H2OModelMetrics") ) return( object@metrics$aecu_table )
    if( is(object, "H2OModel") ) {
        model.parts <- .model.parts(object)
        if ( !train && !valid ) {
            metric <- model.parts$tm@metrics$aecu_table
            if ( !is.null(metric) ) return(metric)
        }
        v <- c()
        v_names <- c()
        if ( train ) {
            v <- c(v,model.parts$tm@metrics$aecu_table)
            v_names <- c(v_names,"train")
        }
        if ( valid ) {
            if( is.null(model.parts$vm) ) return(invisible(.warn.no.validation()))
            else {
                v <- c(v,model.parts$vm@metrics$aecu_table)
                v_names <- c(v_names,"valid")
            }
        }
        if ( !is.null(v) ) {
            names(v) <- v_names
            if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
        }
    }
    warning(paste0("No AECU table for ", class(object)))
    invisible(NULL)
}


#' Internal function that calculates a precise AUC from given
#' probabilities and actual responses.
#' 
#' Note: The underlying implementation is not distributed and can
#' only handle limited size of data. For internal use only.
#' 
#' @param probs An \linkS4class{H2OFrame} holding vector of probabilities.
#' @param acts An \linkS4class{H2OFrame} holding vector of actuals.
.h2o.perfect_auc <- function(probs, acts) {
  .newExpr("perfectAUC", probs, acts)[1, 1]
}

#' Retrieve the all AUC values in a table (One to Rest, One to One, macro and weighted average) 
#' for mutlinomial classification.
#'
#' Retrieves the AUC table from an \linkS4class{H2OMultinomialMetrics}.
#' If "train", "valid", and "xval" parameters are FALSE (default), then the training AUC table is returned. If more
#' than one parameter is set to TRUE, then a named vector of AUC tables are returned, where the names are "train", "valid"
#' or "xval".
#'
#' @param object An \linkS4class{H2OMultinomialMetrics} object.
#' @param train Retrieve the training AUC table
#' @param valid Retrieve the validation AUC table
#' @param xval Retrieve the cross-validation AUC table
#' @seealso \code{\link{h2o.giniCoef}} for the Gini coefficient,
#'          \code{\link{h2o.mse}} for MSE, and \code{\link{h2o.metric}} for the
#'          various threshold metrics. See \code{\link{h2o.performance}} for
#'          creating H2OModelMetrics objects.
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#'
#' prostate_path <- system.file("extdata", "prostate.csv", package = "h2o")
#' prostate <- h2o.uploadFile(prostate_path)
#'
#' prostate[, 2] <- as.factor(prostate[, 2])
#' model <- h2o.gbm(x = 3:9, y = 2, training_frame = prostate, distribution = "bernoulli")
#' perf <- h2o.performance(model, prostate)
#' h2o.multinomial_auc_table(perf)
#' }
#' @export
h2o.multinomial_auc_table <- function(object, train=FALSE, valid=FALSE, xval=FALSE) {
    if( is(object, "H2OModelMetrics") ) return( object@metrics$multinomial_auc_table )
    if( is(object, "H2OModel") ) {
        model.parts <- .model.parts(object)
        if ( !train && !valid && !xval ) {
            metric <- model.parts$tm@metrics$multinomial_auc_table
            if ( !is.null(metric) ) return(metric)
        }
        v <- c()
        v_names <- c()
        if ( train ) {
            v <- c(v,model.parts$tm@metrics$multinomial_auc_table)
            v_names <- c(v_names,"train")
        }
        if ( valid ) {
            if( is.null(model.parts$vm) ) return(invisible(.warn.no.validation()))
            else {
                v <- c(v,model.parts$vm@metrics$multinomial_auc_table)
                v_names <- c(v_names,"valid")
            }
        }
        if ( xval ) {
            if( is.null(model.parts$xm) ) return(invisible(.warn.no.cross.validation()))
            else {
                v <- c(v,model.parts$xm@metrics$multinomial_auc_table)
                v_names <- c(v_names,"xval")
            }
        }
        if ( !is.null(v) ) {
            names(v) <- v_names
            if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
        }
    }
    warning(paste0("Multinomial AUC table is not computed because it is disabled (model parameter 'auc_type' is set to AUTO or NONE) or due to domain size (maximum is 50 domains).", class(object)))
    invisible(NULL)
}

#' Retrieve the AUCPR (Area Under Precision Recall Curve)
#'
#' Retrieves the AUCPR value from an \linkS4class{H2OBinomialMetrics}.
#' If "train", "valid", and "xval" parameters are FALSE (default), then the training AUCPR value is returned. If more
#' than one parameter is set to TRUE, then a named vector of AUCPRs are returned, where the names are "train", "valid"
#' or "xval".
#'
#' @param object An \linkS4class{H2OBinomialMetrics} object.
#' @param train Retrieve the training aucpr
#' @param valid Retrieve the validation aucpr
#' @param xval Retrieve the cross-validation aucpr
#' @seealso \code{\link{h2o.giniCoef}} for the Gini coefficient,
#'          \code{\link{h2o.mse}} for MSE, and \code{\link{h2o.metric}} for the
#'          various threshold metrics. See \code{\link{h2o.performance}} for
#'          creating H2OModelMetrics objects.
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#'
#' prostate_path <- system.file("extdata", "prostate.csv", package = "h2o")
#' prostate <- h2o.uploadFile(prostate_path)
#'
#' prostate[, 2] <- as.factor(prostate[, 2])
#' model <- h2o.gbm(x = 3:9, y = 2, training_frame = prostate, distribution = "bernoulli")
#' perf <- h2o.performance(model, prostate)
#' h2o.aucpr(perf)
#' }
#' @export
h2o.aucpr <- function(object, train=FALSE, valid=FALSE, xval=FALSE) {
  if( is(object, "H2OModelMetrics") ) return( object@metrics$pr_auc )
  if( is(object, "H2OModel") ) {
    model.parts <- .model.parts(object)
    if ( !train && !valid && !xval ) {
      metric <- model.parts$tm@metrics$pr_auc
      if ( !is.null(metric) ) return(metric)
    }
    v <- c()
    v_names <- c()
    if ( train ) {
      v <- c(v,model.parts$tm@metrics$pr_auc)
      v_names <- c(v_names,"train")
    }
    if ( valid ) {
      if( is.null(model.parts$vm) ) return(invisible(.warn.no.validation()))
      else {
        v <- c(v,model.parts$vm@metrics$pr_auc)
        v_names <- c(v_names,"valid")
      }
    }
    if ( xval ) {
      if( is.null(model.parts$xm) ) return(invisible(.warn.no.cross.validation()))
      else {
        v <- c(v,model.parts$xm@metrics$pr_auc)
        v_names <- c(v_names,"xval")
      }
    }
    if ( !is.null(v) ) {
      names(v) <- v_names
      if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
    }
  }
  warning(paste0("Multinomial PR AUC table is not computed because it is disabled (model parameter 'auc_type' is set to AUTO or NONE) or due to domain size (maximum is 50 domains).", class(object)))
  invisible(NULL)
}

#' Retrieve the all PR AUC values in a table (One to Rest, One to One, macro and weighted average) 
#' for mutlinomial classification.
#'
#' Retrieves the PR AUC table from an \linkS4class{H2OMultinomialMetrics}.
#' If "train", "valid", and "xval" parameters are FALSE (default), then the training PR AUC table is returned. If more
#' than one parameter is set to TRUE, then a named vector of PR AUC tables are returned, where the names are "train", "valid"
#' or "xval".
#'
#' @param object An \linkS4class{H2OMultinomialMetrics} object.
#' @param train Retrieve the training PR AUC table
#' @param valid Retrieve the validation PR AUC table
#' @param xval Retrieve the cross-validation PR AUC table
#' @seealso \code{\link{h2o.giniCoef}} for the Gini coefficient,
#'          \code{\link{h2o.mse}} for MSE, and \code{\link{h2o.metric}} for the
#'          various threshold metrics. See \code{\link{h2o.performance}} for
#'          creating H2OModelMetrics objects.
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#'
#' prostate_path <- system.file("extdata", "prostate.csv", package = "h2o")
#' prostate <- h2o.uploadFile(prostate_path)
#'
#' prostate[, 2] <- as.factor(prostate[, 2])
#' model <- h2o.gbm(x = 3:9, y = 2, training_frame = prostate, distribution = "bernoulli")
#' perf <- h2o.performance(model, prostate)
#' h2o.multinomial_aucpr_table(perf)
#' }
#' @export
h2o.multinomial_aucpr_table <- function(object, train=FALSE, valid=FALSE, xval=FALSE) {
    if( is(object, "H2OModelMetrics") ) return( object@metrics$multinomial_aucpr_table )
    if( is(object, "H2OModel") ) {
        model.parts <- .model.parts(object)
        if ( !train && !valid && !xval ) {
            metric <- model.parts$tm@metrics$multinomial_aucpr_table
            if ( !is.null(metric) ) return(metric)
        }
        v <- c()
        v_names <- c()
        if ( train ) {
            v <- c(v,model.parts$tm@metrics$multinomial_aucpr_table)
            v_names <- c(v_names,"train")
        }
        if ( valid ) {
            if( is.null(model.parts$vm) ) return(invisible(.warn.no.validation()))
            else {
                v <- c(v,model.parts$vm@metrics$multinomial_aucpr_table)
                v_names <- c(v_names,"valid")
            }
        }
        if ( xval ) {
            if( is.null(model.parts$xm) ) return(invisible(.warn.no.cross.validation()))
            else {
                v <- c(v,model.parts$xm@metrics$multinomial_aucpr_table)
                v_names <- c(v_names,"xval")
            }
        }
        if ( !is.null(v) ) {
            names(v) <- v_names
            if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
        }
    }
    warning(paste0("No PR AUC table for ", class(object)))
    invisible(NULL)
}

#' @rdname h2o.aucpr
#' @export
h2o.pr_auc <- function(object, train=FALSE, valid=FALSE, xval=FALSE) {
  .Deprecated("h2o.aucpr")
  h2o.aucpr(object, train, valid, xval)
}

#' Retrieve the mean per class error
#'
#' Retrieves the mean per class error from an \linkS4class{H2OBinomialMetrics}.
#' If "train", "valid", and "xval" parameters are FALSE (default), then the training mean per class error value is returned. If more
#' than one parameter is set to TRUE, then a named vector of mean per class errors are returned, where the names are "train", "valid"
#' or "xval".
#'
#' @param object An \linkS4class{H2OBinomialMetrics} object.
#' @param train Retrieve the training mean per class error
#' @param valid Retrieve the validation mean per class error
#' @param xval Retrieve the cross-validation mean per class error
#' @seealso \code{\link{h2o.mse}} for MSE, and \code{\link{h2o.metric}} for the
#'          various threshold metrics. See \code{\link{h2o.performance}} for
#'          creating H2OModelMetrics objects.
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#'
#' prostate_path <- system.file("extdata", "prostate.csv", package = "h2o")
#' prostate <- h2o.uploadFile(prostate_path)
#'
#' prostate[, 2] <- as.factor(prostate[, 2])
#' model <- h2o.gbm(x = 3:9, y = 2, training_frame = prostate, distribution = "bernoulli")
#' perf <- h2o.performance(model, prostate)
#' h2o.mean_per_class_error(perf)
#' h2o.mean_per_class_error(model, train=TRUE)
#' }
#' @export
h2o.mean_per_class_error <- function(object, train=FALSE, valid=FALSE, xval=FALSE) {
  if( is(object, "H2OModelMetrics") ) return( object@metrics$mean_per_class_error )
  if( is(object, "H2OModel") ) {
    model.parts <- .model.parts(object)
    if ( !train && !valid && !xval ) {
      metric <- model.parts$tm@metrics$mean_per_class_error
      if ( !is.null(metric) ) return(metric)
    }
    v <- c()
    v_names <- c()
    if ( train ) {
      v <- c(v,model.parts$tm@metrics$mean_per_class_error)
      v_names <- c(v_names,"train")
    }
    if ( valid ) {
      if( is.null(model.parts$vm) ) return(invisible(.warn.no.validation()))
      else {
        v <- c(v,model.parts$vm@metrics$mean_per_class_error)
        v_names <- c(v_names,"valid")
      }
    }
    if ( xval ) {
      if( is.null(model.parts$xm) ) return(invisible(.warn.no.cross.validation()))
      else {
        v <- c(v,model.parts$xm@metrics$mean_per_class_error)
        v_names <- c(v_names,"xval")
      }
    }
    if ( !is.null(v) ) {
      names(v) <- v_names
      if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
    }
  }
  warning(paste0("No mean per class error for ", class(object)))
  invisible(NULL)
}

#'
#' Retrieve the Akaike information criterion (AIC) value
#'
#' Retrieves the AIC value.
#' If "train", "valid", and "xval" parameters are FALSE (default), then the training AIC value is returned. If more
#' than one parameter is set to TRUE, then a named vector of AICs are returned, where the names are "train", "valid"
#' or "xval".
#'
#' @param object An \linkS4class{H2OModel} or \linkS4class{H2OModelMetrics}.
#' @param train Retrieve the training AIC
#' @param valid Retrieve the validation AIC
#' @param xval Retrieve the cross-validation AIC
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' prostate_path <- system.file("extdata", "prostate.csv", package = "h2o")
#' prostate <- h2o.uploadFile(path = prostate_path)
#' p_sid <- h2o.runif(prostate)
#' prostate_train <- prostate[p_sid > .2,]
#' prostate_glm <- h2o.glm(x = 3:7, y = 2, training_frame = prostate_train)
#' aic_basic <- h2o.aic(prostate_glm)
#' print(aic_basic)
#' }
#' @export
h2o.aic <- function(object, train=FALSE, valid=FALSE, xval=FALSE) {
  if( is(object, "H2OModelMetrics") ) return( object@metrics$AIC )
  if( is(object, "H2OModel") ) {
    model.parts <- .model.parts(object)
    if ( !train && !valid && !xval ) {
      metric <- model.parts$tm@metrics$AIC
      if ( !is.null(metric) ) return(metric)
    }
    v <- c()
    v_names <- c()
    if ( train ) {
      v <- c(v,model.parts$tm@metrics$AIC)
      v_names <- c(v_names,"train")
    }
    if ( valid ) {
      if( is.null(model.parts$vm) ) return(invisible(.warn.no.validation()))
      else {
        v <- c(v,model.parts$vm@metrics$AIC)
        v_names <- c(v_names,"valid")
      }
    }
    if ( xval ) {
      if( is.null(model.parts$xm) ) return(invisible(.warn.no.cross.validation()))
      else {
        v <- c(v,model.parts$xm@metrics$AIC)
        v_names <- c(v_names,"xval")
      }
    }
    if ( !is.null(v) ) {
      names(v) <- v_names
      if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
    }
  }
  warning(paste0("No AIC for ", class(object)))
  invisible(NULL)
}

#'
#' Retrieve the R2 value
#'
#' Retrieves the R2 value from an H2O model.
#' Will return R^2 for GLM Models and will return NaN otherwise.
#' If "train", "valid", and "xval" parameters are FALSE (default), then the training R2 value is returned. If more
#' than one parameter is set to TRUE, then a named vector of R2s are returned, where the names are "train", "valid"
#' or "xval".
#'
#' @param object An \linkS4class{H2OModel} object.
#' @param train Retrieve the training R2
#' @param valid  Retrieve the validation set R2 if a validation set was passed in during model build time.
#' @param xval Retrieve the cross-validation R2
#' @examples
#' \dontrun{
#' library(h2o)
#'
#' h <- h2o.init()
#' fr <- as.h2o(iris)
#'
#' m <- h2o.glm(x = 2:5, y = 1, training_frame = fr)
#'
#' h2o.r2(m)
#' }
#' @export
h2o.r2 <- function(object, train=FALSE, valid=FALSE, xval=FALSE) {
  if( is(object, "H2OModelMetrics") ) return( object@metrics$r2 )
  if( is(object, "H2OModel") ) {
    model.parts <- .model.parts(object)
    if ( !train && !valid && !xval ) {
      metric <- model.parts$tm@metrics$r2
      if ( !is.null(metric) ) return(metric)
    }
    v <- c()
    v_names <- c()
    if ( train ) {
      v <- c(v,model.parts$tm@metrics$r2)
      v_names <- c(v_names,"train")
    }
    if ( valid ) {
      if( is.null(model.parts$vm) ) return(invisible(.warn.no.validation()))
      else {
        v <- c(v,model.parts$vm@metrics$r2)
        v_names <- c(v_names,"valid")
      }
    }
    if ( xval ) {
      if( is.null(model.parts$xm) ) return(invisible(.warn.no.cross.validation()))
      else {
        v <- c(v,model.parts$xm@metrics$r2)
        v_names <- c(v_names,"xval")
      }
    }
    if ( !is.null(v) ) {
      names(v) <- v_names
      if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
    }
  }
  warning(paste0("No R2 for ", class(object)))
  invisible(NULL)
}

#'
#' Retrieve the Mean Residual Deviance value
#'
#' Retrieves the Mean Residual Deviance value from an H2O model.
#' If "train", "valid", and "xval" parameters are FALSE (default), then the training Mean Residual Deviance value is returned. If more
#' than one parameter is set to TRUE, then a named vector of Mean Residual Deviances are returned, where the names are "train", "valid"
#' or "xval".
#'
#' @param object An \linkS4class{H2OModel} object.
#' @param train Retrieve the training Mean Residual Deviance
#' @param valid Retrieve the validation Mean Residual Deviance
#' @param xval Retrieve the cross-validation Mean Residual Deviance
#' @examples
#' \dontrun{
#' library(h2o)
#'
#' h <- h2o.init()
#' fr <- as.h2o(iris)
#'
#' m <- h2o.deeplearning(x = 2:5, y = 1, training_frame = fr)
#'
#' h2o.mean_residual_deviance(m)
#' }
#' @export
h2o.mean_residual_deviance <- function(object, train=FALSE, valid=FALSE, xval=FALSE) {
  if( is(object, "H2OModelMetrics") ) return( object@metrics$mean_residual_deviance )
  if( is(object, "H2OModel") ) {
    model.parts <- .model.parts(object)
    if ( !train && !valid && !xval ) {
      metric <- model.parts$tm@metrics$mean_residual_deviance
      if ( !is.null(metric) ) return(metric)
    }
    v <- c()
    v_names <- c()
    if ( train ) {
      v <- c(v,model.parts$tm@metrics$mean_residual_deviance)
      v_names <- c(v_names,"train")
    }
    if ( valid ) {
      if( is.null(model.parts$vm) ) return(invisible(.warn.no.validation()))
      else {
        v <- c(v,model.parts$vm@metrics$mean_residual_deviance)
        v_names <- c(v_names,"valid")
      }
    }
    if ( xval ) {
      if( is.null(model.parts$xm) ) return(invisible(.warn.no.cross.validation()))
      else {
        v <- c(v,model.parts$xm@metrics$mean_residual_deviance)
        v_names <- c(v_names,"xval")
      }
    }
    if ( !is.null(v) ) {
      names(v) <- v_names
      if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
    }
  }
  warning(paste0("No mean residual deviance for ", class(object)))
  invisible(NULL)
}

#' Retrieve HGLM ModelMetrics
#'
#' @param object an H2OModel object or H2OModelMetrics.
#' @export
h2o.HGLMMetrics <- function(object) {
    if( is(object, "H2OModel") ) {
        model.parts <- .model.parts(object)
        return(model.parts$tm@metrics)
    }
    warning(paste0("No HGLM Metric for ",class(object)))
    invisible(NULL)
}

#' Retrieve the GINI Coefficcient
#'
#' Retrieves the GINI coefficient from an \linkS4class{H2OBinomialMetrics}.
#' If "train", "valid", and "xval" parameters are FALSE (default), then the training GINIvalue is returned. If more
#' than one parameter is set to TRUE, then a named vector of GINIs are returned, where the names are "train", "valid"
#' or "xval".
#'
#' @param object an \linkS4class{H2OBinomialMetrics} object.
#' @param train Retrieve the training GINI Coefficcient
#' @param valid Retrieve the validation GINI Coefficcient
#' @param xval Retrieve the cross-validation GINI Coefficcient
#' @seealso \code{\link{h2o.auc}} for AUC,  \code{\link{h2o.giniCoef}} for the
#'          GINI coefficient, and \code{\link{h2o.metric}} for the various
#'          threshold metrics. See \code{\link{h2o.performance}} for creating 
#'          H2OModelMetrics objects.
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#'
#' prostate_path <- system.file("extdata", "prostate.csv", package = "h2o")
#' prostate <- h2o.uploadFile(prostate_path)
#'
#' prostate[, 2] <- as.factor(prostate[, 2])
#' model <- h2o.gbm(x = 3:9, y = 2, training_frame = prostate, distribution = "bernoulli")
#' perf <- h2o.performance(model, prostate)
#' h2o.giniCoef(perf)
#' }
#' @export
h2o.giniCoef <- function(object, train=FALSE, valid=FALSE, xval=FALSE) {
  if(is(object, "H2OModelMetrics")) return( object@metrics$Gini )
  if( is(object, "H2OModel") ) {
    model.parts <- .model.parts(object)
    if ( !train && !valid && !xval ) {
      metric <- model.parts$tm@metrics$Gini
      if ( !is.null(metric) ) return(metric)
    }
    v <- c()
    v_names <- c()
    if ( train ) {
      v <- c(v,model.parts$tm@metrics$Gini)
      v_names <- c(v_names,"train")
    }
    if ( valid ) {
      if( is.null(model.parts$vm) ) return(invisible(.warn.no.validation()))
      else {
        v <- c(v,model.parts$vm@metrics$Gini)
        v_names <- c(v_names,"valid")
      }
    }
    if ( xval ) {
      if( is.null(model.parts$xm) ) return(invisible(.warn.no.cross.validation()))
      else {
        v <- c(v,model.parts$xm@metrics$Gini)
        v_names <- c(v_names,"xval")
      }
    }
    if ( !is.null(v) ) {
      names(v) <- v_names
      if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
    }
  }
  warning(paste0("No Gini for ",class(object)))
  invisible(NULL)
}

#'
#' Return the coefficients that can be applied to the non-standardized data.
#'
#' Note: standardize = True by default. If set to False, then coef() returns the coefficients that are fit directly.
#'
#' @param object An \linkS4class{H2OModel} object.
#' @param predictorSize predictor subset size.  If specified, will only return model coefficients of that subset size.  If
#'          not specified will return a lists of model coefficient dicts for all predictor subset size.
#' @param object an \linkS4class{H2OModel} object.
#' @examples 
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' 
#' f <- "https://s3.amazonaws.com/h2o-public-test-data/smalldata/junit/cars_20mpg.csv"
#' cars <- h2o.importFile(f)
#' predictors <- c("displacement", "power", "weight", "acceleration", "year")
#' response <- "cylinders"
#' cars_split <- h2o.splitFrame(data = cars, ratios = 0.8, seed = 1234)
#' train <- cars_split[[1]]
#' valid <- cars_split[[2]]
#' cars_glm <- h2o.glm(balance_classes = TRUE, 
#'                     seed = 1234, 
#'                     x = predictors, 
#'                     y = response, 
#'                     training_frame = train, 
#'                     validation_frame = valid)
#' h2o.coef(cars_glm)
#' }
#' @export
h2o.coef <- function(object, predictorSize=-1) {
  if (is(object, "H2OModel") && object@algorithm %in% c("glm", "gam", "coxph", "modelselection")) {
    if ((object@algorithm == "glm" || object@algorithm == "gam") && (object@allparameters$family %in% c("multinomial", "ordinal"))) {
        grabCoeff(object@model$coefficients_table, "coefs_class", FALSE)
    } else {
      if (object@algorithm == "modelselection") {
        modelIDs <- object@model$best_model_ids
        numModels <- length(modelIDs)
        mode <- object@parameters$mode
        maxPredNumbers <- length(object@model$best_model_predictors[[numModels]])
        if (predictorSize == 0)
          stop("predictorSize (predictor subset size) must be between 0 and the total number of predictors used.")
        if (predictorSize > maxPredNumbers)
          stop("predictorSize (predictor subset size) cannot exceed the total number of predictors used.")
        if (predictorSize > 0) { # subset size was specified
          if (mode == "backward") {
            return(grabOneModelCoef(modelIDs, numModels-(maxPredNumbers-predictorSize), FALSE))
          } else {
            return(grabOneModelCoef(modelIDs, predictorSize, FALSE))
          }
        } else {
        coeffs <- vector("list", numModels)
        for (index in seq(numModels)) {
          coeffs[[index]] <- grabOneModelCoef(modelIDs, index, FALSE)
        }
        return(coeffs)
          }
      } else {
        structure(object@model$coefficients_table$coefficients,
                names = object@model$coefficients_table$names)
      }
    }
  } else {
    stop("Can only extract coefficients from GAM, GLM and CoxPH models")
  }
}

grabOneModelCoef <- function(modelIDs, index, standardized) {
  oneModel <- h2o.getModel(modelIDs[[index]]$name)
  if (standardized) {
    return(h2o.coef_norm(oneModel))
  } else {
      return(h2o.coef(oneModel))
  }
}

#'
#' Return coefficients fitted on the standardized data (requires standardize = True, which is on by default). These coefficients can be used to evaluate variable importance.
#'
#' @param object an \linkS4class{H2OModel} object.
#' @param predictorSize predictor subset size.  If specified, will only return model coefficients of that subset size.  If
#'          not specified will return a lists of model coefficient dicts for all predictor subset size.
#' @examples 
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' 
#' f <- "https://s3.amazonaws.com/h2o-public-test-data/smalldata/junit/cars_20mpg.csv"
#' cars <- h2o.importFile(f)
#' predictors <- c("displacement", "power", "weight", "acceleration", "year")
#' response <- "cylinders"
#' cars_split <- h2o.splitFrame(data = cars, ratios = 0.8, seed = 1234)
#' train <- cars_split[[1]]
#' valid <- cars_split[[2]]
#' cars_glm <- h2o.glm(balance_classes = TRUE, 
#'                     seed = 1234, 
#'                     x = predictors, 
#'                     y = response, 
#'                     training_frame = train, 
#'                     validation_frame = valid)
#' h2o.coef_norm(cars_glm)
#' }
#' @export
h2o.coef_norm <- function(object, predictorSize=-1) {
  if (is(object, "H2OModel") &&
      (object@algorithm %in% c("glm", "gam", "coxph", "modelselection"))) {
    if (object@algorithm == "modelselection") {
      modelIDs <- object@model$best_model_ids
      numModels = length(modelIDs)
      mode <- object@parameters$mode
      maxPredNumbers <- length(object@model$best_model_predictors[[numModels]])
      if (predictorSize == 0)
        stop("predictorSize (predictor subset size) must be between 0 and the total number of predictors used.")
      if (predictorSize > maxPredNumbers)
        stop("predictorSize (predictor subset size) cannot exceed the total number of predictors used.")
      if (predictorSize > 0) { # subset size was specified 
          if (mode == "backward") {
            return(grabOneModelCoef(modelIDs, numModels-(maxPredNumbers-predictorSize), TRUE))
          } else {
            return(grabOneModelCoef(modelIDs, predictorSize, TRUE))
          }
      } else {
      coeffs <- vector("list", numModels)
      for (index in seq(numModels)) {
        coeffs[[index]] <- grabOneModelCoef(modelIDs, index, TRUE)
      }
      return(coeffs)
      }
    }
    if (object@allparameters$family %in% c("multinomial", "ordinal")) {
      grabCoeff(object@model$coefficients_table,
                "std_coefs_class",
                TRUE)
    } else {
      structure(
        object@model$coefficients_table$standardized_coefficients,
        names = object@model$coefficients_table$names
      )
    }
  } else {
    stop("Can only extract coefficients from GAMs/GLMs")
  }
}

grabCoeff <- function(tempTable, nameStart, standardize=FALSE) {
    coeffNamesPerClass <- tempTable$names # contains coeff names per class
    totTableLength <- length(tempTable)
    startIndex <- 2
    endIndex <- (totTableLength-1)/2+1
    if (standardize) {
        startIndex <- (totTableLength-1)/2+2   # starting index for standardized coefficients
        endIndex <- totTableLength
    }
    coeffClassNames <- c("coefficient_names")
    coeffPerClassAll <- list(coefficients_names=coeffNamesPerClass)
    cindex <- 0
    for (index in c(startIndex:endIndex)) {
        vals <- tempTable[,index]
        coeffClassNames <- c(coeffClassNames, paste(nameStart, cindex, sep="_"))
        cindex <- cindex+1
        coeffPerClassAll[[cindex+1]] <- vals
    }
    structure(coeffPerClassAll, names=coeffClassNames)
}

#' Retrieves Mean Squared Error Value
#'
#' Retrieves the mean squared error value from an \linkS4class{H2OModelMetrics}
#' object.
#' If "train", "valid", and "xval" parameters are FALSE (default), then the training MSEvalue is returned. If more
#' than one parameter is set to TRUE, then a named vector of MSEs are returned, where the names are "train", "valid"
#' or "xval".
#'
#' This function only supports \linkS4class{H2OBinomialMetrics},
#' \linkS4class{H2OMultinomialMetrics}, and \linkS4class{H2ORegressionMetrics} objects.
#'
#' @param object An \linkS4class{H2OModelMetrics} object of the correct type.
#' @param train Retrieve the training MSE
#' @param valid Retrieve the validation MSE
#' @param xval Retrieve the cross-validation MSE
#' @seealso \code{\link{h2o.auc}} for AUC, \code{\link{h2o.mse}} for MSE, and
#'          \code{\link{h2o.metric}} for the various threshold metrics. See
#'          \code{\link{h2o.performance}} for creating H2OModelMetrics objects.
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#'
#' prostate_path <- system.file("extdata", "prostate.csv", package = "h2o")
#' prostate <- h2o.uploadFile(prostate_path)
#'
#' prostate[, 2] <- as.factor(prostate[, 2])
#' model <- h2o.gbm(x = 3:9, y = 2, training_frame = prostate, distribution = "bernoulli")
#' perf <- h2o.performance(model, prostate)
#' h2o.mse(perf)
#' }
#' @export
h2o.mse <- function(object, train=FALSE, valid=FALSE, xval=FALSE) {
  if( is(object, "H2OModelMetrics") ) return( object@metrics$MSE )
  if( is(object, "H2OModel") ) {
    metrics <- NULL # break out special for clustering vs the rest
    model.parts <- .model.parts(object)
    if ( !train && !valid && !xval ) {
      metric <- model.parts$tm@metrics$MSE
      if ( !is.null(metric) ) return(metric)
    }
    v <- c()
    v_names <- c()
    if ( train ) {
      if( is(object, "H2OClusteringModel") ) v <- model.parts$tm@metrics$centroid_stats$within_cluster_sum_of_squares
      else v <- c(v,model.parts$tm@metrics$MSE)
      v_names <- c(v_names,"train")
    }
    if ( valid ) {
      if( is.null(model.parts$vm) ) return(invisible(.warn.no.validation()))
      else {
        if( is(object, "H2OClusteringModel") ) v <- model.parts$vm@metrics$centroid_stats$within_cluster_sum_of_squares
        else v <- c(v,model.parts$vm@metrics$MSE)
        v_names <- c(v_names,"valid")
      }
    }
    if ( xval ) {
      if( is.null(model.parts$xm) ) return(invisible(.warn.no.cross.validation()))
      else {
        if( is(object, "H2OClusteringModel") ) v <- model.parts$xm@metrics$centroid_stats$within_cluster_sum_of_squares
        else v <- c(v,model.parts$xm@metrics$MSE)
        v_names <- c(v_names,"xval")
      }
    }
    if ( !is.null(v) ) {
      names(v) <- v_names
      if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
    }
  }
  warning(paste0("No MSE for ",class(object)))
  invisible(NULL)
}

#' Retrieves Root Mean Squared Error Value
#'
#' Retrieves the root mean squared error value from an \linkS4class{H2OModelMetrics}
#' object.
#' If "train", "valid", and "xval" parameters are FALSE (default), then the training RMSEvalue is returned. If more
#' than one parameter is set to TRUE, then a named vector of RMSEs are returned, where the names are "train", "valid"
#' or "xval".
#'
#' This function only supports \linkS4class{H2OBinomialMetrics},
#' \linkS4class{H2OMultinomialMetrics}, and \linkS4class{H2ORegressionMetrics} objects.
#'
#' @param object An \linkS4class{H2OModelMetrics} object of the correct type.
#' @param train Retrieve the training RMSE
#' @param valid Retrieve the validation RMSE
#' @param xval Retrieve the cross-validation RMSE
#' @seealso \code{\link{h2o.auc}} for AUC, \code{\link{h2o.mse}} for RMSE, and
#'          \code{\link{h2o.metric}} for the various threshold metrics. See
#'          \code{\link{h2o.performance}} for creating H2OModelMetrics objects.
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#'
#' prostate_path <- system.file("extdata", "prostate.csv", package = "h2o")
#' prostate <- h2o.uploadFile(prostate_path)
#'
#' prostate[, 2] <- as.factor(prostate[, 2])
#' model <- h2o.gbm(x = 3:9, y = 2, training_frame = prostate, distribution = "bernoulli")
#' perf <- h2o.performance(model, prostate)
#' h2o.rmse(perf)
#' }
#' @export
h2o.rmse <- function(object, train=FALSE, valid=FALSE, xval=FALSE) {
  if( is(object, "H2OModelMetrics") ) return( object@metrics$RMSE )
  if( is(object, "H2OModel") ) {
    metrics <- NULL # break out special for clustering vs the rest
    model.parts <- .model.parts(object)
    if ( !train && !valid && !xval ) {
      metric <- model.parts$tm@metrics$RMSE
      if ( !is.null(metric) ) return(metric)
    }
    v <- c()
    v_names <- c()
    if ( train ) {
      if( is(object, "H2OClusteringModel") ) v <- model.parts$tm@metrics$centroid_stats$within_cluster_sum_of_squares
      else v <- c(v,model.parts$tm@metrics$RMSE)
      v_names <- c(v_names,"train")
    }
    if ( valid ) {
      if( is.null(model.parts$vm) ) return(invisible(.warn.no.validation()))
      else {
        if( is(object, "H2OClusteringModel") ) v <- model.parts$vm@metrics$centroid_stats$within_cluster_sum_of_squares
        else v <- c(v,model.parts$vm@metrics$RMSE)
        v_names <- c(v_names,"valid")
      }
    }
    if ( xval ) {
      if( is.null(model.parts$xm) ) return(invisible(.warn.no.cross.validation()))
      else {
        if( is(object, "H2OClusteringModel") ) v <- model.parts$xm@metrics$centroid_stats$within_cluster_sum_of_squares
        else v <- c(v,model.parts$xm@metrics$RMSE)
        v_names <- c(v_names,"xval")
      }
    }
    if ( !is.null(v) ) {
      names(v) <- v_names
      if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
    }
  }
  warning(paste0("No RMSE for ",class(object)))
  invisible(NULL)
}

#'
#' Retrieve the Mean Absolute Error Value
#'
#' Retrieves the mean absolute error (MAE) value from an H2O model.
#' If "train", "valid", and "xval" parameters are FALSE (default), then the training MAE value is returned. If more
#' than one parameter is set to TRUE, then a named vector of MAEs are returned, where the names are "train", "valid"
#' or "xval".
#'
#' @param object An \linkS4class{H2OModel} object.
#' @param train Retrieve the training MAE
#' @param valid  Retrieve the validation set MAE if a validation set was passed in during model build time.
#' @param xval Retrieve the cross-validation MAE
#' @examples
#' \dontrun{
#' library(h2o)
#'
#' h <- h2o.init()
#' fr <- as.h2o(iris)
#'
#' m <- h2o.deeplearning(x = 2:5, y = 1, training_frame = fr)
#'
#' h2o.mae(m)
#' }
#' @export
h2o.mae <- function(object, train=FALSE, valid=FALSE, xval=FALSE) {
  if( is(object, "H2OModelMetrics") ) return( object@metrics$mae )
  if( is(object, "H2OModel") ) {
    model.parts <- .model.parts(object)
    if ( !train && !valid && !xval ) {
      metric <- model.parts$tm@metrics$mae
      if ( !is.null(metric) ) return(metric)
    }
    v <- c()
    v_names <- c()
    if ( train ) {
      v <- c(v,model.parts$tm@metrics$mae)
      v_names <- c(v_names,"train")
    }
    if ( valid ) {
      if( is.null(model.parts$vm) ) return(invisible(.warn.no.validation()))
      else {
        v <- c(v,model.parts$vm@metrics$mae)
        v_names <- c(v_names,"valid")
      }
    }
    if ( xval ) {
      if( is.null(model.parts$xm) ) return(invisible(.warn.no.cross.validation()))
      else {
        v <- c(v,model.parts$xm@metrics$mae)
        v_names <- c(v_names,"xval")
      }
    }
    if ( !is.null(v) ) {
      names(v) <- v_names
      if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
    }
  }
  warning(paste0("No MAE for ", class(object)))
  invisible(NULL)
}

#'
#' Retrieve the Root Mean Squared Log Error
#'
#' Retrieves the root mean squared log error (RMSLE) value from an H2O model.
#' If "train", "valid", and "xval" parameters are FALSE (default), then the training rmsle value is returned. If more
#' than one parameter is set to TRUE, then a named vector of rmsles are returned, where the names are "train", "valid"
#' or "xval".
#'
#' @param object An \linkS4class{H2OModel} object.
#' @param train Retrieve the training rmsle
#' @param valid  Retrieve the validation set rmsle if a validation set was passed in during model build time.
#' @param xval Retrieve the cross-validation rmsle
#' @examples
#' \dontrun{
#' library(h2o)
#'
#' h <- h2o.init()
#' fr <- as.h2o(iris)
#'
#' m <- h2o.deeplearning(x = 2:5, y = 1, training_frame = fr)
#'
#' h2o.rmsle(m)
#' }
#' @export
h2o.rmsle <- function(object, train=FALSE, valid=FALSE, xval=FALSE) {
  if( is(object, "H2OModelMetrics") ) return( object@metrics$rmsle )
  if( is(object, "H2OModel") ) {
    model.parts <- .model.parts(object)
    if ( !train && !valid && !xval ) {
      metric <- model.parts$tm@metrics$rmsle
      if ( !is.null(metric) ) return(metric)
    }
    v <- c()
    v_names <- c()
    if ( train ) {
      v <- c(v,model.parts$tm@metrics$rmsle)
      v_names <- c(v_names,"train")
    }
    if ( valid ) {
      if( is.null(model.parts$vm) ) return(invisible(.warn.no.validation()))
      else {
        v <- c(v,model.parts$vm@metrics$rmsle)
        v_names <- c(v_names,"valid")
      }
    }
    if ( xval ) {
      if( is.null(model.parts$xm) ) return(invisible(.warn.no.cross.validation()))
      else {
        v <- c(v,model.parts$xm@metrics$rmsle)
        v_names <- c(v_names,"xval")
      }
    }
    if ( !is.null(v) ) {
      names(v) <- v_names
      if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
    }
  }
  warning(paste0("No rmsle for ", class(object)))
  invisible(NULL)
}

#' Retrieve the Log Loss Value
#'
#' Retrieves the log loss output for a \linkS4class{H2OBinomialMetrics} or
#' \linkS4class{H2OMultinomialMetrics} object
#' If "train", "valid", and "xval" parameters are FALSE (default), then the training Log Loss value is returned. If more
#' than one parameter is set to TRUE, then a named vector of Log Losses are returned, where the names are "train", "valid"
#' or "xval".
#'
#' @param object a \linkS4class{H2OModelMetrics} object of the correct type.
#' @param train Retrieve the training Log Loss
#' @param valid Retrieve the validation Log Loss
#' @param xval Retrieve the cross-validation Log Loss
#' @examples 
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' 
#' f <- "https://s3.amazonaws.com/h2o-public-test-data/smalldata/junit/cars_20mpg.csv"
#' cars <- h2o.importFile(f)
#' cars["economy_20mpg"] <- as.factor(cars["economy_20mpg"])
#' predictors <- c("displacement", "power", "weight", "acceleration", "year")
#' response <- "economy_20mpg"
#' cars_splits <- h2o.splitFrame(data =  cars, ratios = .8, seed = 1234)
#' train <- cars_splits[[1]]
#' valid <- cars_splits[[2]]
#' car_drf <- h2o.randomForest(x = predictors, 
#'                             y = response, 
#'                             training_frame = train, 
#'                             validation_frame = valid)
#' h2o.logloss(car_drf, train = TRUE, valid = TRUE)
#' }
#' @export
h2o.logloss <- function(object, train=FALSE, valid=FALSE, xval=FALSE) {
  if( is(object, "H2OModelMetrics") ) return( object@metrics$logloss )
  if( is(object, "H2OModel") ) {
    model.parts <- .model.parts(object)
    if ( !train && !valid && !xval ) {
      metric <- model.parts$tm@metrics$logloss
      if ( !is.null(metric) ) return(metric)
    }
    v <- c()
    v_names <- c()
    if ( train ) {
      v <- c(v,model.parts$tm@metrics$logloss)
      v_names <- c(v_names,"train")
    }
    if ( valid ) {
      if( is.null(model.parts$vm) ) return(invisible(.warn.no.validation()))
      else {
        v <- c(v,model.parts$vm@metrics$logloss)
        v_names <- c(v_names,"valid")
      }
    }
    if ( xval ) {
      if( is.null(model.parts$xm) ) return(invisible(.warn.no.cross.validation()))
      else {
        v <- c(v,model.parts$xm@metrics$logloss)
        v_names <- c(v_names,"xval")
      }
    }
    if ( !is.null(v) ) {
      names(v) <- v_names
      if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
    }
  }
  warning(paste("No log loss for",class(object)))
  invisible(NULL)
}


#'
#' Retrieve per-variable split information for a given Isolation Forest model.
#' Output will include:
#' - count - The number of times a variable was used to make a split.
#' - aggregated_split_ratios - The split ratio is defined as "abs(#left_observations - #right_observations) / #before_split".
#'                             Even splits (#left_observations approx the same as #right_observations) contribute
#'                             less to the total aggregated split ratio value for the given feature;
#'                             highly imbalanced splits (eg. #left_observations >> #right_observations) contribute more.
#' - aggregated_split_depths - The sum of all depths of a variable used to make a split. (If a variable is used
#'                             on level N of a tree, then it contributes with N to the total aggregate.)
#' @param object An Isolation Forest model represented by \linkS4class{H2OModel} object.
#' @export
h2o.varsplits <- function(object) {
  if( is(object, "H2OModel") ) {
    vi <- object@model$variable_splits
    if( is.null(vi) ) {
      warning("This model doesn't have variable splits information, only Isolation Forest can be used with h2o.varsplits().", call. = FALSE)
      return(invisible(NULL))
    }
    vi
  } else {
    warning( paste0("No variable importances for ", class(object)) )
    return(NULL)
  }
}

#'
#' Retrieve Model Score History
#'
#' @param object An \linkS4class{H2OModel} object.
#' @examples 
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' 
#' f <- "https://s3.amazonaws.com/h2o-public-test-data/smalldata/junit/cars_20mpg.csv"
#' cars <- h2o.importFile(f)
#' cars["economy_20mpg"] <- as.factor(cars["economy_20mpg"])
#' predictors <- c("displacement", "power", "weight", "acceleration", "year")
#' response <- "economy_20mpg"
#' cars_split <- h2o.splitFrame(data = cars, ratios = 0.8, seed = 1234)
#' train <- cars_split[[1]]
#' valid <- cars_split[[2]]
#' cars_gbm <- h2o.gbm(x = predictors, y = response, 
#'                     training_frame = train, 
#'                     validation_frame = valid, 
#'                     seed = 1234)
#' h2o.scoreHistory(cars_gbm)
#' }
#' @export
h2o.scoreHistory <- function(object) {
  o <- object
  if( is(o, "H2OModel") ) {
    sh <- o@model$scoring_history
    if( is.null(sh) ) return(NULL)
    sh
  } else {
    warning( paste0("No score history for ", class(o)) )
    return(NULL)
  }
}

#'
#' Retrieve GLM Model Score History buried in GAM model
#' @param object An \linkS4class{H2OModel} object.
#' @export
h2o.scoreHistoryGAM <- function(object) {
    return(object@model$glm_scoring_history)
}

#'
#' Retrieve actual number of trees for tree algorithms
#'
#' @param object An \linkS4class{H2OModel} object.
#' @export
h2o.get_ntrees_actual <- function(object) {
    o <- object
    if( is(o, "H2OModel") ) {
        if(o@algorithm == "gbm" | o@algorithm == "drf"| o@algorithm == "isolationforest"| o@algorithm == "xgboost" | o@algorithm == "extendedisolationforest" | o@algorithm == "upliftdrf"){
            sh <- o@model$model_summary['number_of_trees'][,1]
            if( is.null(sh) ) return(NULL)
            sh
        } else {
            warning( paste0("No actual number of trees for this model") )
            return(NULL)
        }
    } else {
        warning( paste0("No actual number of trees for ", class(o)) )
        return(NULL)
    }
}

#' Feature interactions and importance, leaf statistics and split value histograms in a tabular form.
#' Available for XGBoost and GBM.
#'
#' Metrics:
#' Gain - Total gain of each feature or feature interaction.
#' FScore - Amount of possible splits taken on a feature or feature interaction.
#' wFScore - Amount of possible splits taken on a feature or feature interaction weighed by 
#' the probability of the splits to take place.
#' Average wFScore - wFScore divided by FScore.
#' Average Gain - Gain divided by FScore.
#' Expected Gain - Total gain of each feature or feature interaction weighed by the probability to gather the gain.
#' Average Tree Index
#' Average Tree Depth
#'
#' @param model A trained xgboost model.
#' @param max_interaction_depth Upper bound for extracted feature interactions depth. Defaults to 100.
#' @param max_tree_depth Upper bound for tree depth. Defaults to 100.
#' @param max_deepening Upper bound for interaction start deepening (zero deepening => interactions 
#' starting at root only). Defaults to -1.
#'
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' boston <- h2o.importFile(
#'        "https://s3.amazonaws.com/h2o-public-test-data/smalldata/gbm_test/BostonHousing.csv",
#'         destination_frame="boston"
#'         )
#' boston_xgb <- h2o.xgboost(training_frame = boston, y = "medv", seed = 1234)
#' feature_interactions <- h2o.feature_interaction(boston_xgb)
#' }
#' @export
h2o.feature_interaction <- function(model, max_interaction_depth = 100, max_tree_depth = 100, max_deepening = -1) {
    o <- model
    if (is(o, "H2OModel")) {
        if (o@algorithm == "gbm" | o@algorithm == "xgboost"){
            parms <- list()
            parms$model_id <- model@model_id
            parms$max_interaction_depth <- max_interaction_depth
            parms$max_tree_depth <- max_tree_depth
            parms$max_deepening <- max_deepening
            
            json <- .h2o.doSafePOST(urlSuffix = "FeatureInteraction", parms=parms)
            source <- .h2o.fromJSON(jsonlite::fromJSON(json,simplifyDataFrame=FALSE))
            
            return(source$feature_interaction)
        } else {
            warning(paste0("No calculation available for this model"))
            return(NULL)
        }
    } else {
        warning(paste0("No calculation available for ", class(o)))
        return(NULL)
    }
}


#' Calculates Friedman and Popescu's H statistics, in order to test for the presence of an interaction between specified variables in h2o gbm and xgb models.
#' H varies from 0 to 1. It will have a value of 0 if the model exhibits no interaction between specified variables and a correspondingly larger value for a 
#' stronger interaction effect between them. NaN is returned if a computation is spoiled by weak main effects and rounding errors.
#' 
#' See Jerome H. Friedman and Bogdan E. Popescu, 2008, "Predictive learning via rule ensembles", *Ann. Appl. Stat.*
#' **2**:916-954, http://projecteuclid.org/download/pdfview_1/euclid.aoas/1223908046, s. 8.1.
#'
#' @param model A trained gradient-boosting model.  
#' @param frame A frame that current model has been fitted to.
#' @param variables Variables of the interest.
#'
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' prostate.hex <- h2o.importFile(
#'        "https://s3.amazonaws.com/h2o-public-test-data/smalldata/logreg/prostate.csv",
#'         destination_frame="prostate.hex"
#'         )
#' prostate.hex$CAPSULE <- as.factor(prostate.hex$CAPSULE)
#' prostate.hex$RACE <- as.factor(prostate.hex$RACE)
#' prostate.h2o <- h2o.gbm(x = 3:9, y = "CAPSULE", training_frame = prostate.hex, 
#' distribution = "bernoulli", ntrees = 100, max_depth = 5, min_rows = 10, learn_rate = 0.1)
#' h_val <- h2o.h(prostate.h2o, prostate.hex, c('DPROS','DCAPS'))
#' }
#' @export
h2o.h <- function(model, frame, variables) {
    o <- model
    if (is(o, "H2OModel")) {
        if (o@algorithm == "gbm" | o@algorithm == "xgboost"){
            parms <- list()
            parms$model_id <- model@model_id
            parms$frame <- h2o.getId(frame)
            parms$variables <- .collapse.char(variables)

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

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

#'
#' Retrieve the respective weight matrix
#'
#' @param object An \linkS4class{H2OModel} or \linkS4class{H2OModelMetrics}
#' @param matrix_id An integer, ranging from 1 to number of layers + 1, that specifies the weight matrix to return.
#' @examples 
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' 
#' f <- "https://s3.amazonaws.com/h2o-public-test-data/smalldata/chicago/chicagoCensus.csv"
#' census <- h2o.importFile(f)
#' census[, 1] <- as.factor(census[, 1])
#' dl_model <- h2o.deeplearning(x = c(1:3), y = 4, training_frame = census,
#'                             hidden = c(17, 191), 
#'                             epochs = 1,
#'                             balance_classes = FALSE,
#'                             export_weights_and_biases = TRUE)
#' h2o.weights(dl_model, matrix_id = 1)
#' }
#' @export
h2o.weights <- function(object, matrix_id=1){
  o <- object
  if( is(o, "H2OModel") ) {
    sh <- o@model$weights[[matrix_id]]
    if( is.null(sh) ) return(NULL)
    sh
  } else {
    warning( paste0("No weights for ", class(o)) )
    return(NULL)
  }
  h2o.getFrame(sh$name)
}

#'
#' Return the respective bias vector
#'
#' @param object An \linkS4class{H2OModel} or \linkS4class{H2OModelMetrics}
#' @param vector_id An integer, ranging from 1 to number of layers + 1, that specifies the bias vector to return.
#' @examples 
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' 
#' f <- "https://h2o-public-test-data.s3.amazonaws.com/smalldata/chicago/chicagoCensus.csv"
#' census <- h2o.importFile(f)
#' census[, 1] <- as.factor(census[, 1])
#' 
#' dl_model <- h2o.deeplearning(x = c(1:3), y = 4, training_frame = census,
#'                             hidden = c(17, 191),
#'                             epochs = 1, 
#'                             balance_classes = FALSE, 
#'                             export_weights_and_biases = TRUE)
#' h2o.biases(dl_model, vector_id = 1)
#' }
#' @export
h2o.biases <- function(object, vector_id=1){
  o <- object
  if( is(o, "H2OModel") ) {
    sh <- o@model$biases[[vector_id]]
    if( is.null(sh) ) return(NULL)
    sh
  } else {
    warning( paste0("No biases for ", class(o)) )
    return(NULL)
  }
  h2o.getFrame(sh$name)
}

#'
#' Retrieve the Hit Ratios
#'
#' If "train", "valid", and "xval" parameters are FALSE (default), then the training Hit Ratios value is returned. If more
#' than one parameter is set to TRUE, then a named list of Hit Ratio tables are returned, where the names are "train", "valid"
#' or "xval".
#'
#' @param object An \linkS4class{H2OModel} object.
#' @param train Retrieve the training Hit Ratio
#' @param valid Retrieve the validation Hit Ratio
#' @param xval Retrieve the cross-validation Hit Ratio
#' @examples 
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' 
#' f <- "https://s3.amazonaws.com/h2o-public-test-data/smalldata/iris/iris_wheader.csv"
#' iris <- h2o.importFile(f)
#' iris_split <- h2o.splitFrame(data = iris, ratios = 0.8, seed = 1234)
#' train <- iris_split[[1]]
#' valid <- iris_split[[2]]
#' 
#' iris_xgb <- h2o.xgboost(x = 1:4, y = 5, training_frame = train, validation_frame = valid)
#' hrt_iris <- h2o.hit_ratio_table(iris_xgb, valid = TRUE)
#' hrt_iris
#' }
#' @export
h2o.hit_ratio_table <- function(object, train=FALSE, valid=FALSE, xval=FALSE) {
  if( is(object, "H2OModelMetrics") ) return( object@metrics$hit_ratio_table )
  if( is(object, "H2OModel") ) {
    model.parts <- .model.parts(object)
    if ( !train && !valid && !xval ) {
      metric <- model.parts$tm@metrics$hit_ratio_table
      if ( !is.null(metric) ) return(metric)
    }
    v <- list()
    v_names <- c()
    if ( train ) {
      v[[length(v)+1]] <- model.parts$tm@metrics$hit_ratio_table
      v_names <- c(v_names,"train")
    }
    if ( valid ) {
      if( is.null(model.parts$vm) ) return(invisible(.warn.no.validation()))
      else {
        v[[length(v)+1]] <- model.parts$vm@metrics$hit_ratio_table
        v_names <- c(v_names,"valid")
      }
    }
    if ( xval ) {
      if( is.null(model.parts$xm) ) return(invisible(.warn.no.cross.validation()))
      else {
        v[[length(v)+1]] <- model.parts$xm@metrics$hit_ratio_table
        v_names <- c(v_names,"xval")
      }
    }
    if ( !is.null(v) ) {
      names(v) <- v_names
      if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
    }
  }
  # if o is a data.frame, then the hrt was passed in -- just for pretty printing
  if( is(object, "data.frame") ) return(object)

  # warn if we got something unexpected...
  warning( paste0("No hit ratio table for ", class(object)) )
  invisible(NULL)
}

#' H2O Model Metric Accessor Functions
#'
#' A series of functions that retrieve model metric details.
#'
#' Many of these functions have an optional thresholds parameter. Currently
#' only increments of 0.1 are allowed. If not specified, the functions will
#' return all possible values. Otherwise, the function will return the value for
#' the indicated threshold.
#'
#' Currently, the these functions are only supported by
#' \linkS4class{H2OBinomialMetrics} objects.
#'
#' @param object An \linkS4class{H2OModelMetrics} object of the correct type.
#' @param thresholds (Optional) A value or a list of values between 0.0 and 1.0.
#'        If not set, then all thresholds will be returned.
#'        If "max", then the threshold maximizing the metric will be used.
#' @param metric (Optional) the metric to retrieve.
#'        If not set, then all metrics will be returned.
#' @param transform (Optional) a list describing a transformer for the given metric, if any.
#'        e.g. transform=list(op=foo_fn, name="foo") will rename the given metric to "foo"
#'             and apply function foo_fn to the metric values.
#' @return Returns either a single value, or a list of values.
#' @seealso \code{\link{h2o.auc}} for AUC, \code{\link{h2o.giniCoef}} for the
#'          GINI coefficient, and \code{\link{h2o.mse}} for MSE. See
#'          \code{\link{h2o.performance}} for creating H2OModelMetrics objects.
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#'
#' prostate_path <- system.file("extdata", "prostate.csv", package = "h2o")
#' prostate <- h2o.uploadFile(prostate_path)
#'
#' prostate$CAPSULE <- as.factor(prostate$CAPSULE)
#' model <- h2o.gbm(x = 3:9, y = 2, training_frame = prostate, distribution = "bernoulli")
#' perf <- h2o.performance(model, prostate)
#' h2o.F1(perf)
#' }
#' @export
h2o.metric <- function(object, thresholds, metric, transform=NULL) {
  if (!is(object, "H2OModelMetrics")) stop(paste0("No ", metric, " for ",class(object)," .Should be a H2OModelMetrics object!"))
  if (is(object, "H2OBinomialMetrics")){
    avail_metrics <- names(object@metrics$thresholds_and_metric_scores)
    avail_metrics <- avail_metrics[!(avail_metrics %in% c('threshold', 'idx'))]
    if (missing(thresholds)) {
      if (missing(metric)) {
        metrics <- object@metrics$thresholds_and_metric_scores
      } else {
        h2o_metric <- sapply(metric, function(m) ifelse(m %in% avail_metrics, m, ifelse(m %in% names(.h2o.metrics_aliases), .h2o.metrics_aliases[m], m)))
        metrics <- object@metrics$thresholds_and_metric_scores[, c("threshold", h2o_metric)]
        if (!missing(transform)) {
          if ('op' %in% names(transform)) {
            metrics[h2o_metric] <- transform$op(metrics[h2o_metric])
          }
          if ('name' %in% names(transform)) {
            names(metrics) <- c("threshold", transform$name)
          }
        }
      }
    } else if (all(thresholds == 'max') && missing(metric)) {
      metrics <- object@metrics$max_criteria_and_metric_scores
    } else {
      if (missing(metric)) {
        h2o_metric <- avail_metrics
      } else {
        h2o_metric <- unlist(lapply(metric, function(m) ifelse(m %in% avail_metrics, m, ifelse(m %in% names(.h2o.metrics_aliases), .h2o.metrics_aliases[m], m))))
      }
      if (all(thresholds == 'max')) thresholds <- h2o.find_threshold_by_max_metric(object, h2o_metric)
      metrics <- lapply(thresholds, function(t,o,m) h2o.find_row_by_threshold(o, t)[, m], object, h2o_metric)
      if (!missing(transform) && 'op' %in% names(transform)) {
        metrics <- lapply(metrics, transform$op)
      }
    }
    return(metrics)
  }
  else {
    stop(paste0("No ", metric, " for ",class(object)))
  }
}

#' @rdname h2o.metric
#' @export
h2o.F0point5 <- function(object, thresholds){
  h2o.metric(object, thresholds, "f0point5")
}

#' @rdname h2o.metric
#' @export
h2o.F1 <- function(object, thresholds){
  h2o.metric(object, thresholds, "f1")
}

#' @rdname h2o.metric
#' @export
h2o.F2 <- function(object, thresholds){
  h2o.metric(object, thresholds, "f2")
}

#' @rdname h2o.metric
#' @export
h2o.accuracy <- function(object, thresholds){
  h2o.metric(object, thresholds, "accuracy")
}

#' @rdname h2o.metric
#' @export
h2o.error <- function(object, thresholds){
  h2o.metric(object, thresholds, "accuracy", transform=list(name="error", op=function(acc) 1 - acc))
}

#' @rdname h2o.metric
#' @export
h2o.maxPerClassError <- function(object, thresholds){
  h2o.metric(object, thresholds, "min_per_class_accuracy", transform=list(name="max_per_class_error", op=function(mpc_acc) 1 - mpc_acc))
}

#' @rdname h2o.metric
#' @export
h2o.mean_per_class_accuracy <- function(object, thresholds){
  h2o.metric(object, thresholds, "mean_per_class_accuracy")
}

#' @rdname h2o.metric
#' @export
h2o.mcc <- function(object, thresholds){
  h2o.metric(object, thresholds, "absolute_mcc")
}

#' @rdname h2o.metric
#' @export
h2o.precision <- function(object, thresholds){
  h2o.metric(object, thresholds, "precision")
}

#' @rdname h2o.metric
#' @export
h2o.tpr <- function(object, thresholds){
  h2o.metric(object, thresholds, "tpr")
}

#' @rdname h2o.metric
#' @export
h2o.fpr <- function(object, thresholds){
  h2o.metric(object, thresholds, "fpr")
}

#' @rdname h2o.metric
#' @export
h2o.fnr <- function(object, thresholds){
  h2o.metric(object, thresholds, "fnr")
}

#' @rdname h2o.metric
#' @export
h2o.tnr <- function(object, thresholds){
  h2o.metric(object, thresholds, "tnr")
}

#' @rdname h2o.metric
#' @export
h2o.recall <- function(object, thresholds){
  h2o.metric(object, thresholds, "tpr")
}

#' @rdname h2o.metric
#' @export
h2o.sensitivity <- function(object, thresholds){
  h2o.metric(object, thresholds, "tpr")
}

#' @rdname h2o.metric
#' @export
h2o.fallout <- function(object, thresholds){
  h2o.metric(object, thresholds, "fpr")
}

#' @rdname h2o.metric
#' @export
h2o.missrate <- function(object, thresholds){
  h2o.metric(object, thresholds, "fnr")
}

#' @rdname h2o.metric
#' @export
h2o.specificity <- function(object, thresholds){
  h2o.metric(object, thresholds, "tnr")
}

#' Find the threshold, give the max metric
#'
#' @rdname h2o.find_threshold_by_max_metric
#' @param object H2OBinomialMetrics
#' @param metric "F1," for example
#' @examples 
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' 
#' f <- "https://s3.amazonaws.com/h2o-public-test-data/smalldata/junit/cars_20mpg.csv"
#' cars <- h2o.importFile(f)
#' cars["economy_20mpg"] <- as.factor(cars["economy_20mpg"])
#' predictors <- c("displacement", "power", "weight", "acceleration", "year")
#' response <- "economy_20mpg"
#' cars_split <- h2o.splitFrame(data = cars, ratios = 0.8, seed = 1234)
#' train <- cars_split[[1]]
#' valid <- cars_split[[2]]
#' cars_gbm <- h2o.gbm(x = predictors, y = response, 
#'                     training_frame = train, validation_frame = valid, 
#'                     build_tree_one_node = TRUE , seed = 1234)
#' perf <- h2o.performance(cars_gbm, cars)
#' h2o.find_threshold_by_max_metric(perf, "fnr")
#' }
#' @export
h2o.find_threshold_by_max_metric <- function(object, metric) {
  if(!is(object, "H2OBinomialMetrics")) stop(paste0("No ", metric, " for ",class(object)))
  max_metrics <- object@metrics$max_criteria_and_metric_scores
  h2o_metric <- sapply(metric, function(m) ifelse(m %in% names(.h2o.metrics_aliases), .h2o.metrics_aliases[m], m))
  max_metrics[match(paste0("max ", h2o_metric), max_metrics$metric), "threshold"]
}

#' Find the threshold, give the max metric. No duplicate thresholds allowed
#'
#' @rdname h2o.find_row_by_threshold
#' @param object H2OBinomialMetrics
#' @param threshold number between 0 and 1
#' @examples 
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' 
#' f <- "https://s3.amazonaws.com/h2o-public-test-data/smalldata/junit/cars_20mpg.csv"
#' cars <- h2o.importFile(f)
#' cars["economy_20mpg"] <- as.factor(cars["economy_20mpg"])
#' predictors <- c("displacement", "power", "weight", "acceleration", "year")
#' response <- "economy_20mpg"
#' cars_split <- h2o.splitFrame(data = cars, ratios = 0.8, seed = 1234)
#' train <- cars_split[[1]]
#' valid <- cars_split[[2]]
#' cars_gbm <- h2o.gbm(x = predictors, y = response, 
#'                     training_frame = train, validation_frame = valid, 
#'                     build_tree_one_node = TRUE , seed = 1234)
#' perf <- h2o.performance(cars_gbm, cars)
#' h2o.find_row_by_threshold(perf, 0.5)
#' }
#' @export
h2o.find_row_by_threshold <- function(object, threshold) {
  if(!is(object, "H2OBinomialMetrics")) stop(paste0("No ", threshold, " for ",class(object)))
  tmp <- object@metrics$thresholds_and_metric_scores
  if( is.null(tmp) ) return(NULL)
  res <- tmp[abs(as.numeric(tmp$threshold) - threshold) < 1e-8,]  # relax the tolerance
  if( nrow(res) == 0L ) {
    # couldn't find any threshold within 1e-8 of the requested value, warn and return closest threshold
    row_num <- which.min(abs(tmp$threshold - threshold))
    closest_threshold <- tmp$threshold[row_num]
    warning( paste0("Could not find exact threshold: ", threshold, " for this set of metrics; using closest threshold found: ", closest_threshold, ". Run `h2o.predict` and apply your desired threshold on a probability column.") )
    return( tmp[row_num,] )
  }
  else if( nrow(res) > 1L ) res <- res[1L,]
  res
}

#'
#' Retrieve the Model Centers
#'
#' @param object An \linkS4class{H2OClusteringModel} object.
#' @examples 
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' fr <- h2o.importFile("https://h2o-public-test-data.s3.amazonaws.com/smalldata/iris/iris_train.csv")
#' h2o.ceiling(fr[, 1])
#' }
#' @export
h2o.centers <- function(object) { as.data.frame(object@model$centers[,-1]) }

#'
#' Retrieve the Model Centers STD
#'
#' @param object An \linkS4class{H2OClusteringModel} object.
#' @examples 
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' fr <- h2o.importFile("https://h2o-public-test-data.s3.amazonaws.com/smalldata/iris/iris_train.csv")
#' predictors <- c("sepal_len", "sepal_wid", "petal_len", "petal_wid")
#' km <- h2o.kmeans(x = predictors, training_frame = fr, k = 3, nfolds = 3)
#' h2o.centersSTD(km)
#' }
#' @export
h2o.centersSTD <- function(object) { as.data.frame(object@model$centers_std)[,-1] }

#'
#' Get the Within SS
#'
#' @param object An \linkS4class{H2OClusteringModel} object.
#' @export
h2o.withinss <- function(object) { h2o.mse(object) }

#'
#' Get the total within cluster sum of squares.
#'
#' If "train", "valid", and "xval" parameters are FALSE (default), then the training tot_withinss value is returned. If more
#' than one parameter is set to TRUE, then a named vector of tot_withinss' are returned, where the names are "train", "valid"
#' or "xval".
#'
#' @param object An \linkS4class{H2OClusteringModel} object.
#' @param train Retrieve the training total within cluster sum of squares
#' @param valid Retrieve the validation total within cluster sum of squares
#' @param xval Retrieve the cross-validation total within cluster sum of squares
#' @examples 
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' 
#' fr <- h2o.importFile("https://h2o-public-test-data.s3.amazonaws.com/smalldata/iris/iris_train.csv")
#' predictors <- c("sepal_len", "sepal_wid", "petal_len", "petal_wid")
#' km <- h2o.kmeans(x = predictors, training_frame = fr, k = 3, nfolds = 3)
#' h2o.tot_withinss(km, train = TRUE)
#' }
#' @export
h2o.tot_withinss <- function(object, train=FALSE, valid=FALSE, xval=FALSE) {
  model.parts <- .model.parts(object)
  if ( !train && !valid && !xval ) return( model.parts$tm@metrics$tot_withinss )
  v <- c()
  v_names <- c()
  if ( train ) {
    v <- c(v,model.parts$tm@metrics$tot_withinss)
    v_names <- c(v_names,"train")
  }
  if ( valid ) {
    if( is.null(model.parts$vm) ) invisible(.warn.no.validation())
    else {
      v <- c(v,model.parts$vm@metrics$tot_withinss)
      v_names <- c(v_names,"valid")
    }
  }
  if ( xval ) {
    if( is.null(model.parts$xm) ) invisible(.warn.no.cross.validation())
    else {
      v <- c(v,model.parts$xm@metrics$tot_withinss)
      v_names <- c(v_names,"xval")
    }
  }
  names(v) <- v_names
  if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
}

#' Get the between cluster sum of squares
#'
#' Get the between cluster sum of squares.
#' If "train", "valid", and "xval" parameters are FALSE (default), then the training betweenss value is returned. If more
#' than one parameter is set to TRUE, then a named vector of betweenss' are returned, where the names are "train", "valid"
#' or "xval".
#'
#' @param object An \linkS4class{H2OClusteringModel} object.
#' @param train Retrieve the training between cluster sum of squares
#' @param valid Retrieve the validation between cluster sum of squares
#' @param xval Retrieve the cross-validation between cluster sum of squares
#' @examples 
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' fr <- h2o.importFile("https://h2o-public-test-data.s3.amazonaws.com/smalldata/iris/iris_train.csv")
#' predictors <- c("sepal_len", "sepal_wid", "petal_len", "petal_wid")
#' km <- h2o.kmeans(x = predictors, training_frame = fr, k = 3, nfolds = 3)
#' h2o.betweenss(km, train = TRUE)
#' }
#' @export
h2o.betweenss <- function(object, train=FALSE, valid=FALSE, xval=FALSE) {
  model.parts <- .model.parts(object)
  if ( !train && !valid && !xval ) return( model.parts$tm@metrics$betweenss )
  v <- c()
  v_names <- c()
  if ( train ) {
    v <- c(v,model.parts$tm@metrics$betweenss)
    v_names <- c(v_names,"train")
  }
  if ( valid ) {
    if( is.null(model.parts$vm) ) invisible(.warn.no.validation())
    else {
      v <- c(v,model.parts$vm@metrics$betweenss)
      v_names <- c(v_names,"valid")
    }
  }
  if ( xval ) {
    if( is.null(model.parts$xm) ) invisible(.warn.no.cross.validation())
    else {
      v <- c(v,model.parts$xm@metrics$betweenss)
      v_names <- c(v_names,"xval")
    }
  }
  names(v) <- v_names
  if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
}

#'
#' Get the total sum of squares.
#'
#' If "train", "valid", and "xval" parameters are FALSE (default), then the training totss value is returned. If more
#' than one parameter is set to TRUE, then a named vector of totss' are returned, where the names are "train", "valid"
#' or "xval".
#'
#' @param object An \linkS4class{H2OClusteringModel} object.
#' @param train Retrieve the training total sum of squares
#' @param valid Retrieve the validation total sum of squares
#' @param xval Retrieve the cross-validation total sum of squares
#' @examples 
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' 
#' fr <- h2o.importFile("https://h2o-public-test-data.s3.amazonaws.com/smalldata/iris/iris_train.csv")
#' predictors <- c("sepal_len", "sepal_wid", "petal_len", "petal_wid")
#' km <- h2o.kmeans(x = predictors, training_frame = fr, k = 3, nfolds = 3)
#' h2o.totss(km, train = TRUE)
#' }
#' @export
h2o.totss <- function(object, train=FALSE, valid=FALSE, xval=FALSE) {
  model.parts <- .model.parts(object)
  if ( !train && !valid && !xval ) return( model.parts$tm@metrics$totss )
  v <- c()
  v_names <- c()
  if ( train ) {
    v <- c(v,model.parts$tm@metrics$totss)
    v_names <- c(v_names,"train")
  }
  if ( valid ) {
    if( is.null(model.parts$vm) ) invisible(.warn.no.validation())
    else {
      v <- c(v,model.parts$vm@metrics$totss)
      v_names <- c(v_names,"valid")
    }
  }
  if ( xval ) {
    if( is.null(model.parts$xm) ) invisible(.warn.no.cross.validation())
    else {
      v <- c(v,model.parts$xm@metrics$totss)
      v_names <- c(v_names,"xval")
    }
  }
  names(v) <- v_names
  if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
}

#'
#' Retrieve the number of iterations.
#'
#' @param object An \linkS4class{H2OClusteringModel} object.
#' @examples 
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' 
#' prostate_path <- system.file("extdata", "prostate.csv", package = "h2o")
#' prostate <- h2o.importFile(prostate_path)
#' prostate[, 2] <- as.factor(prostate[, 2])
#' prostate_glm <- h2o.glm(y = "CAPSULE", x = c("AGE", "RACE", "PSA", "DCAPS"), 
#'                         training_frame = prostate, family = "binomial", 
#'                         nfolds = 0, alpha = 0.5, lambda_search = FALSE)
#' h2o.num_iterations(prostate_glm)
#' }

#' @export
h2o.num_iterations <- function(object) { object@model$model_summary$number_of_iterations }

#'
#' Retrieve centroid statistics
#'
#' Retrieve the centroid statistics.
#' If "train" and "valid" parameters are FALSE (default), then the training centroid stats value is returned. If more
#' than one parameter is set to TRUE, then a named list of centroid stats data frames are returned, where the names are "train" or "valid"
#' For cross validation metrics this statistics are not available.
#'
#' @param object An \linkS4class{H2OClusteringModel} object.
#' @param train Retrieve the training centroid statistics
#' @param valid Retrieve the validation centroid statistics
#' @examples 
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' fr <- h2o.importFile("https://h2o-public-test-data.s3.amazonaws.com/smalldata/iris/iris_train.csv")
#' predictors <- c("sepal_len", "sepal_wid", "petal_len", "petal_wid")
#' km <- h2o.kmeans(x = predictors, training_frame = fr, k = 3, nfolds = 3)
#' h2o.centroid_stats(km, train = TRUE)
#' }
#' @export
h2o.centroid_stats <- function(object, train=FALSE, valid=FALSE) {
  model.parts <- .model.parts(object)
  if ( !train && !valid) return( model.parts$tm@metrics$centroid_stats )
  v <- list()
  v_names <- c()
  if ( train ) {
    v[[length(v)+1]] <- model.parts$tm@metrics$centroid_stats
    v_names <- c(v_names,"train")
  }
  if ( valid ) {
    if( is.null(model.parts$vm) ) invisible(.warn.no.validation())
    else {
      v[[length(v)+1]] <- model.parts$vm@metrics$centroid_stats
      v_names <- c(v_names,"valid")
    }
  }
  names(v) <- v_names
  if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
}

#'
#' Retrieve the cluster sizes
#'
#' Retrieve the cluster sizes.
#' If "train", "valid", and "xval" parameters are FALSE (default), then the training cluster sizes value is returned. If more
#' than one parameter is set to TRUE, then a named list of cluster size vectors are returned, where the names are "train", "valid"
#' or "xval".
#'
#' @param object An \linkS4class{H2OClusteringModel} object.
#' @param train Retrieve the training cluster sizes
#' @param valid Retrieve the validation cluster sizes
#' @param xval Retrieve the cross-validation cluster sizes
#' @examples 
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' fr <- h2o.importFile("https://h2o-public-test-data.s3.amazonaws.com/smalldata/iris/iris_train.csv")
#' predictors <- c("sepal_len", "sepal_wid", "petal_len", "petal_wid")
#' km <- h2o.kmeans(x = predictors, training_frame = fr, k = 3, nfolds = 3)
#' h2o.cluster_sizes(km, train = TRUE)
#' }
#' @export
h2o.cluster_sizes <- function(object, train=FALSE, valid=FALSE, xval=FALSE) {
  model.parts <- .model.parts(object)
  if ( !train && !valid && !xval ) return( model.parts$tm@metrics$centroid_stats$size )
  v <- list()
  v_names <- c()
  if ( train ) {
    v[[length(v)+1]] <- model.parts$tm@metrics$centroid_stats$size
    v_names <- c(v_names,"train")
  }
  if ( valid ) {
    if( is.null(model.parts$vm) ) invisible(.warn.no.validation())
    else {
      v[[length(v)+1]] <- model.parts$vm@metrics$centroid_stats$size
      v_names <- c(v_names,"valid")
    }
  }
  if ( xval ) {
    if( is.null(model.parts$xm) ) invisible(.warn.no.cross.validation())
    else {
      v[[length(v)+1]] <- model.parts$xm@metrics$centroid_stats$size
      v_names <- c(v_names,"xval")
    }
  }
  names(v) <- v_names
  if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
}


#'
#' Retrieve the null deviance
#'
#' If "train", "valid", and "xval" parameters are FALSE (default), then the training null deviance value is returned. If more
#' than one parameter is set to TRUE, then a named vector of null deviances are returned, where the names are "train", "valid"
#' or "xval".
#'
#' @param object An \linkS4class{H2OModel} or \linkS4class{H2OModelMetrics}
#' @param train Retrieve the training null deviance
#' @param valid Retrieve the validation null deviance
#' @param xval Retrieve the cross-validation null deviance
#' @examples 
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' 
#' prostate_path <- system.file("extdata", "prostate.csv", package = "h2o")
#' prostate <- h2o.importFile(prostate_path)
#' prostate[, 2] <- as.factor(prostate[, 2])
#' prostate_glm <- h2o.glm(y = "CAPSULE", x = c("AGE", "RACE", "PSA", "DCAPS"), 
#'                         training_frame = prostate, family = "binomial", nfolds = 0, 
#'                         alpha = 0.5, lambda_search = FALSE)
#' h2o.null_deviance(prostate_glm, train = TRUE)
#' }
#' @export
h2o.null_deviance <- function(object, train=FALSE, valid=FALSE, xval=FALSE) {
  if( is(object, "H2OModelMetrics") ) return( object@metrics$null_deviance )
  if( is(object, "H2OModel") ) {
    model.parts <- .model.parts(object)
    if ( !train && !valid && !xval ) {
      metric <- model.parts$tm@metrics$null_deviance
      if ( !is.null(metric) ) return(metric)
    }
    v <- c()
    v_names <- c()
    if ( train ) {
      v <- c(v,model.parts$tm@metrics$null_deviance)
      v_names <- c(v_names,"train")
    }
    if ( valid ) {
      if( is.null(model.parts$vm) ) return(invisible(.warn.no.validation()))
      else {
        v <- c(v,model.parts$vm@metrics$null_deviance)
        v_names <- c(v_names,"valid")
      }
    }
    if ( xval ) {
      if( is.null(model.parts$xm) ) return(invisible(.warn.no.cross.validation()))
      else {
        v <- c(v,model.parts$xm@metrics$null_deviance)
        v_names <- c(v_names,"xval")
      }
    }
    if ( !is.null(v) ) {
      names(v) <- v_names
      if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
    }
  }
  warning(paste0("No null deviance for ", class(object)))
  invisible(NULL)
}


#' Retrieve the residual deviance
#'
#' If "train", "valid", and "xval" parameters are FALSE (default), then the training residual deviance value is returned. If more
#' than one parameter is set to TRUE, then a named vector of residual deviances are returned, where the names are "train", "valid"
#' or "xval".
#'
#' @param object An \linkS4class{H2OModel} or \linkS4class{H2OModelMetrics}
#' @param train Retrieve the training residual deviance
#' @param valid Retrieve the validation residual deviance
#' @param xval Retrieve the cross-validation residual deviance
#' @examples 
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' 
#' prostate_path <- system.file("extdata", "prostate.csv", package = "h2o")
#' prostate <- h2o.importFile(prostate_path)
#' prostate[, 2] <- as.factor(prostate[, 2])
#' prostate_glm <- h2o.glm(y = "CAPSULE", x = c("AGE", "RACE", "PSA", "DCAPS"), 
#'                         training_frame = prostate, family = "binomial", 
#'                         nfolds = 0, alpha = 0.5, lambda_search = FALSE)
#' h2o.residual_deviance(prostate_glm, train = TRUE)
#' }
#' @export
h2o.residual_deviance <- function(object, train=FALSE, valid=FALSE, xval=FALSE) {
  if( is(object, "H2OModelMetrics") ) return( object@metrics$residual_deviance )
  if( is(object, "H2OModel") ) {
    model.parts <- .model.parts(object)
    if ( !train && !valid && !xval ) {
      metric <- model.parts$tm@metrics$residual_deviance
      if ( !is.null(metric) ) return(metric)
    }
    v <- c()
    v_names <- c()
    if ( train ) {
      v <- c(v,model.parts$tm@metrics$residual_deviance)
      v_names <- c(v_names,"train")
    }
    if ( valid ) {
      if( is.null(model.parts$vm) ) return(invisible(.warn.no.validation()))
      else {
        v <- c(v,model.parts$vm@metrics$residual_deviance)
        v_names <- c(v_names,"valid")
      }
    }
    if ( xval ) {
      if( is.null(model.parts$xm) ) return(invisible(.warn.no.cross.validation()))
      else {
        v <- c(v,model.parts$xm@metrics$residual_deviance)
        v_names <- c(v_names,"xval")
      }
    }
    if ( !is.null(v) ) {
      names(v) <- v_names
      if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
    }
  }
  warning(paste0("No residual deviance for ", class(object)))
  invisible(NULL)
}


#' Retrieve the residual degrees of freedom
#'
#' If "train", "valid", and "xval" parameters are FALSE (default), then the training residual degrees of freedom value is returned. If more
#' than one parameter is set to TRUE, then a named vector of residual degrees of freedom are returned, where the names are "train", "valid"
#' or "xval".
#'
#' @param object An \linkS4class{H2OModel} or \linkS4class{H2OModelMetrics}
#' @param train Retrieve the training residual degrees of freedom
#' @param valid Retrieve the validation residual degrees of freedom
#' @param xval Retrieve the cross-validation residual degrees of freedom
#' @examples 
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' 
#' prostate_path <- system.file("extdata", "prostate.csv", package = "h2o")
#' prostate <- h2o.importFile(prostate_path)
#' prostate[, 2] <- as.factor(prostate[, 2])
#' prostate_glm <- h2o.glm(y = "CAPSULE", x = c("AGE", "RACE", "PSA", "DCAPS"), 
#'                         training_frame = prostate, family = "binomial", 
#'                         nfolds = 0, alpha = 0.5, lambda_search = FALSE)
#' h2o.residual_dof(prostate_glm, train = TRUE)
#' }
#' @export
h2o.residual_dof <- function(object, train=FALSE, valid=FALSE, xval=FALSE) {
  if( is(object, "H2OModelMetrics") ) return( object@metrics$residual_degrees_of_freedom )
  if( is(object, "H2OModel") ) {
    model.parts <- .model.parts(object)
    if ( !train && !valid && !xval ) {
      metric <- model.parts$tm@metrics$residual_degrees_of_freedom
      if ( !is.null(metric) ) return(metric)
    }
    v <- c()
    v_names <- c()
    if ( train ) {
      v <- c(v,model.parts$tm@metrics$residual_degrees_of_freedom)
      v_names <- c(v_names,"train")
    }
    if ( valid ) {
      if( is.null(model.parts$vm) ) return(invisible(.warn.no.validation()))
      else {
        v <- c(v,model.parts$vm@metrics$residual_degrees_of_freedom)
        v_names <- c(v_names,"valid")
      }
    }
    if ( xval ) {
      if( is.null(model.parts$xm) ) return(invisible(.warn.no.cross.validation()))
      else {
        v <- c(v,model.parts$xm@metrics$residual_degrees_of_freedom)
        v_names <- c(v_names,"xval")
      }
    }
    if ( !is.null(v) ) {
      names(v) <- v_names
      if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
    }
  }
  warning(paste0("No residual dof for ", class(object)))
  invisible(NULL)
}


#' Retrieve the null degrees of freedom
#'
#' If "train", "valid", and "xval" parameters are FALSE (default), then the training null degrees of freedom value is returned. If more
#' than one parameter is set to TRUE, then a named vector of null degrees of freedom are returned, where the names are "train", "valid"
#' or "xval".
#'
#' @param object An \linkS4class{H2OModel} or \linkS4class{H2OModelMetrics}
#' @param train Retrieve the training null degrees of freedom
#' @param valid Retrieve the validation null degrees of freedom
#' @param xval Retrieve the cross-validation null degrees of freedom
#' @examples 
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' 
#' prostate_path <- system.file("extdata", "prostate.csv", package = "h2o")
#' prostate <- h2o.importFile(prostate_path)
#' prostate[, 2] <- as.factor(prostate[, 2])
#' prostate_glm <- h2o.glm(y = "CAPSULE", x = c("AGE", "RACE", "PSA", "DCAPS"), 
#'                         training_frame = prostate, family = "binomial", nfolds = 0, 
#'                         alpha = 0.5, lambda_search = FALSE)
#' h2o.null_dof(prostate_glm, train = TRUE)
#' }
#' @export
h2o.null_dof <- function(object, train=FALSE, valid=FALSE, xval=FALSE) {
  if( is(object, "H2OModelMetrics") ) return( object@metrics$null_degrees_of_freedom )
  if( is(object, "H2OModel") ) {
    model.parts <- .model.parts(object)
    if ( !train && !valid && !xval ) {
      metric <- model.parts$tm@metrics$null_degrees_of_freedom
      if ( !is.null(metric) ) return(metric)
    }
    v <- c()
    v_names <- c()
    if ( train ) {
      v <- c(v,model.parts$tm@metrics$null_degrees_of_freedom)
      v_names <- c(v_names,"train")
    }
    if ( valid ) {
      if( is.null(model.parts$vm) ) return(invisible(.warn.no.validation()))
      else {
        v <- c(v,model.parts$vm@metrics$null_degrees_of_freedom)
        v_names <- c(v_names,"valid")
      }
    }
    if ( xval ) {
      if( is.null(model.parts$xm) ) return(invisible(.warn.no.cross.validation()))
      else {
        v <- c(v,model.parts$xm@metrics$null_degrees_of_freedom)
        v_names <- c(v_names,"xval")
      }
    }
    if ( !is.null(v) ) {
      names(v) <- v_names
      if ( length(v)==1 ) { return( v[[1]] ) } else { return( v ) }
    }
  }
  warning(paste0("No null dof for ", class(object)))
  invisible(NULL)
}

#' Access H2O Gains/Lift Tables
#'
#' Retrieve either a single or many Gains/Lift tables from H2O objects.
#'
#' The \linkS4class{H2OModelMetrics} version of this function will only take
#' \linkS4class{H2OBinomialMetrics} objects.
#'
#' @param object Either an \linkS4class{H2OModel} object or an
#'        \linkS4class{H2OModelMetrics} object.
#' @param newdata An H2OFrame object that can be scored on.
#'        Requires a valid response column.
#' @param valid Retrieve the validation metric.
#' @param xval Retrieve the cross-validation metric.
#' @param \dots further arguments to be passed to/from this method.
#' @return Calling this function on \linkS4class{H2OModel} objects returns a
#'         Gains/Lift table corresponding to the \code{\link{predict}} function.
#' @seealso \code{\link{predict}} for generating prediction frames,
#'          \code{\link{h2o.performance}} for creating
#'          \linkS4class{H2OModelMetrics}.
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' prostate_path <- system.file("extdata", "prostate.csv", package = "h2o")
#' prostate <- h2o.uploadFile(prostate_path)
#' prostate[, 2] <- as.factor(prostate[, 2])
#' model <- h2o.gbm(x = 3:9, y = 2, distribution = "bernoulli",
#'                  training_frame = prostate, validation_frame = prostate, nfolds = 3)
#' h2o.gainsLift(model)              ## extract training metrics
#' h2o.gainsLift(model, valid = TRUE)  ## extract validation metrics (here: the same)
#' h2o.gainsLift(model, xval = TRUE)  ## extract cross-validation metrics
#' h2o.gainsLift(model, newdata = prostate) ## score on new data (here: the same)
#' # Generating a ModelMetrics object
#' perf <- h2o.performance(model, prostate)
#' h2o.gainsLift(perf)               ## extract from existing metrics object
#' }
#' @export
setGeneric("h2o.gainsLift", function(object, ...) {})

#' @rdname h2o.gainsLift
#' @export
setMethod("h2o.gainsLift", "H2OModel", function(object, newdata, valid=FALSE, xval=FALSE,...) {
  model.parts <- .model.parts(object)
  if( missing(newdata) ) {
    if( valid ) {
      if( is.null(model.parts$vm) ) return( invisible(.warn.no.validation()) )
      else                          return( h2o.gainsLift(model.parts$vm) )
    }
    if ( xval ) {
      if( is.null(model.parts$xm) ) return( invisible(.warn.no.cross.validation()))
      else                          return( h2o.gainsLift(model.parts$xm) )
    }
    return( h2o.gainsLift(model.parts$tm) )
  } else {
    if( valid ) stop("Cannot have both `newdata` and `valid=TRUE`", call.=FALSE)
    if( xval )  stop("Cannot have both `newdata` and `xval=TRUE`", call.=FALSE)
  }


  # ok need to score on the newdata
  url <- paste0("Predictions/models/",object@model_id, "/frames/", h2o.getId(newdata))
  res <- .h2o.__remoteSend(url, method="POST")

  # Make the correct class of metrics object
  metrics <- new(sub("Model", "Metrics", class(object)), algorithm=object@algorithm, metrics= res$model_metrics[[1L]])
  h2o.gainsLift(metrics, ...)
})

#' @rdname h2o.gainsLift
#' @export
setMethod("h2o.gainsLift", "H2OModelMetrics", function(object) {
  if( is(object, "H2OBinomialMetrics") ) {
    return(object@metrics$gains_lift_table)
  } else {
    warning(paste0("No Gains/Lift table for ",class(object)))
    return(NULL)
  }
})

#' Kolmogorov-Smirnov metric for binomial models
#'
#' Retrieves a Kolmogorov-Smirnov metric for given binomial model. The number returned is in range between 0 and 1.
#' K-S metric represents the degree of separation between the positive (1) and negative (0) cumulative distribution
#' functions. Detailed metrics per each group are to be found in the gains-lift table.
#'
#' The \linkS4class{H2OModelMetrics} version of this function will only take
#' \linkS4class{H2OBinomialMetrics} objects.
#'
#' @param object Either an \linkS4class{H2OModel} object or an
#'        \linkS4class{H2OModelMetrics} object.
#' @return Kolmogorov-Smirnov metric, a number between 0 and 1.
#' @seealso \code{\link{h2o.gainsLift}} to see detailed K-S metrics per group
#' 
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' data <- h2o.importFile(
#' path = "https://s3.amazonaws.com/h2o-public-test-data/smalldata/airlines/allyears2k_headers.zip")
#' model <- h2o.gbm(x = c("Origin", "Distance"), y = "IsDepDelayed", 
#'                        training_frame = data, ntrees = 1)
#' h2o.kolmogorov_smirnov(model)
#' }
#' @export
setGeneric("h2o.kolmogorov_smirnov", function(object) {})

#' @rdname h2o.kolmogorov_smirnov
#' @export
setMethod("h2o.kolmogorov_smirnov", "H2OModelMetrics", function(object) {
  gains_lift <- h2o.gainsLift(object = object)
  if(is.null(gains_lift)){
    warning(paste0("No Gains/Lift table for ",class(object)))
    return(NULL)
  } else {
    return(max(gains_lift$kolmogorov_smirnov))
  }
  
})

#' @rdname h2o.kolmogorov_smirnov
#' @export
setMethod("h2o.kolmogorov_smirnov", "H2OModel", function(object) {
  gains_lift <- h2o.gainsLift(object = object)
  if(is.null(gains_lift)){
    warning(paste0("No Gains/Lift table for ",class(object)))
    return(NULL)
  } else {
    return(max(gains_lift$kolmogorov_smirnov))
  }
  
})


#' Access H2O Confusion Matrices
#'
#' Retrieve either a single or many confusion matrices from H2O objects.
#'
#' The \linkS4class{H2OModelMetrics} version of this function will only take
#' \linkS4class{H2OBinomialMetrics} or \linkS4class{H2OMultinomialMetrics}
#' objects. If no threshold is specified, all possible thresholds are selected.
#'
#' @param object Either an \linkS4class{H2OModel} object or an
#'        \linkS4class{H2OModelMetrics} object.
#' @param newdata An H2OFrame object that can be scored on.
#'        Requires a valid response column.
#' @param thresholds (Optional) A value or a list of valid values between 0.0 and 1.0.
#'        This value is only used in the case of
#'        \linkS4class{H2OBinomialMetrics} objects.
#' @param metrics (Optional) A metric or a list of valid metrics ("min_per_class_accuracy", "absolute_mcc", "tnr", "fnr", "fpr", "tpr", "precision", "accuracy", "f0point5", "f2", "f1").
#'        This value is only used in the case of
#'        \linkS4class{H2OBinomialMetrics} objects.
#' @param valid Retrieve the validation metric.
#' @param ... Extra arguments for extracting train or valid confusion matrices.
#' @return Calling this function on \linkS4class{H2OModel} objects returns a
#'         confusion matrix corresponding to the \code{\link{predict}} function.
#'         If used on an \linkS4class{H2OBinomialMetrics} object, returns a list
#'         of matrices corresponding to the number of thresholds specified.
#' @seealso \code{\link{predict}} for generating prediction frames,
#'          \code{\link{h2o.performance}} for creating
#'          \linkS4class{H2OModelMetrics}.
#' @examples
#' \dontrun{
#' library(h2o)
#' h2o.init()
#' prostate_path <- system.file("extdata", "prostate.csv", package = "h2o")
#' prostate <- h2o.uploadFile(prostate_path)
#' prostate[, 2] <- as.factor(prostate[, 2])
#' model <- h2o.gbm(x = 3:9, y = 2, training_frame = prostate, distribution = "bernoulli")
#' h2o.confusionMatrix(model, prostate)
#' # Generating a ModelMetrics object
#' perf <- h2o.performance(model, prostate)
#' h2o.confusionMatrix(perf)
#' }
#' @export
setGeneric("h2o.confusionMatrix", function(object, ...) {})

#' @rdname h2o.confusionMatrix
#' @export
setMethod("h2o.confusionMatrix", "H2OModel", function(object, newdata, valid=FALSE, ...) {
  model.parts <- .model.parts(object)
  if( missing(newdata) ) {
    if( valid ) {
      if( is.null(model.parts$vm) ) return( invisible(.warn.no.validation()) )
      else                          return( h2o.confusionMatrix(model.parts$vm, ...) )
    } else                          return( h2o.confusionMatrix(model.parts$tm, ...) )
  } else if( valid ) stop("Cannot have both `newdata` and `valid=TRUE`", call.=FALSE)

  # ok need to score on the newdata
  url <- paste0("Predictions/models/",object@model_id, "/frames/", h2o.getId(newdata))
  res <- .h2o.__remoteSend(url, method="POST")

  # Make the correct class of metrics object
  metrics <- new(sub("Model", "Metrics", class(object)), algorithm=object@algorithm, metrics= res$model_metrics[[1L]])   # FIXME: don't think model metrics come out of Predictions anymore!!!
  h2o.confusionMatrix(metrics, ...)
})

.h2o.metrics_aliases <- list(
    fallout='fpr',
    missrate='fnr',
    recall='tpr',
    sensitivity='tpr',
    specificity='tnr'
)
.h2o.maximizing_metrics <- c('absolute_mcc', 'accuracy', 'precision',
                             'f0point5', 'f1', 'f2',
                             'mean_per_class_accuracy', 'min_per_class_accuracy',
                             'fpr', 'fnr', 'tpr', 'tnr', names(.h2o.metrics_aliases))

#' @rdname h2o.confusionMatrix
#' @export
setMethod("h2o.confusionMatrix", "H2OModelMetrics", function(object, thresholds=NULL, metrics=NULL) {
  if( !is(object, "H2OBinomialMetrics") ) {
    if( is(object, "H2OMultinomialMetrics") ||  is(object, "H2OOrdinalMetrics"))
      return(object@metrics$cm$table)
    warning(paste0("No Confusion Matrices for ",class(object)))
    return(NULL)
  }
  # H2OBinomial case
  if( is.null(metrics) && is.null(thresholds) ) {
    metrics = c("f1")
  }
  if( is(metrics, "list") ) metrics_list = metrics
  else {
    if( is.null(metrics) ) metrics_list = list()
    else metrics_list = list(metrics)
  }
  if( is(thresholds, "list") ) thresholds_list = thresholds
    else {
      if( is.null(thresholds) ) thresholds_list = list()
      else thresholds_list = as.list(thresholds)
  }

  # error check the metrics_list and thresholds_list
  if( !all(sapply(thresholds_list, f <- function(x) is.numeric(x) && x >= 0 && x <= 1)) )
    stop("All thresholds must be numbers between 0 and 1 (inclusive).")
  if( !all(sapply(metrics_list, f <- function(x) x %in% .h2o.maximizing_metrics)) )
      stop(paste("The only allowable metrics are ", paste(.h2o.maximizing_metrics, collapse=', ')))

  # make one big list that combines the thresholds and metric-thresholds
  metrics_thresholds = lapply(metrics_list, f <- function(x) h2o.find_threshold_by_max_metric(object, x))
  thresholds_list <- append(thresholds_list, metrics_thresholds)
  first_metrics_thresholds_offset <- length(thresholds_list) - length(metrics_thresholds)

  thresh2d <- object@metrics$thresholds_and_metric_scores
  actual_thresholds <- thresh2d$threshold
  d <- object@metrics$domain
  m <- lapply(seq_along(thresholds_list), function(i) {
    t <- thresholds_list[[i]]
    row <- h2o.find_row_by_threshold(object,t)
    if( is.null(row) ) NULL
    else {
      tns <- row$tns; fps <- row$fps; fns <- row$fns; tps <- row$tps;
      rnames <- c(d, "Totals")
      cnames <- c(d, "Error", "Rate")
      col1 <- c(tns, fns, tns+fns)
      col2 <- c(fps, tps, fps+tps)
      col3 <- c(fps/(fps+tns), fns/(fns+tps), (fps+fns)/(fps+tns+fns+tps))
      col4 <- c( paste0(" =", fps, "/", fps+tns), paste0(" =", fns, "/", fns+tps), paste0(" =", fns+fps, "/", fps+tns+fns+tps) )
      fmts <- c("%i", "%i", "%f", "%s")
      tbl <- data.frame(col1,col2,col3,col4)
      colnames(tbl) <- cnames
      rownames(tbl) <- rnames
      header <-  "Confusion Matrix (vertical: actual; across: predicted) "
      if(t %in% metrics_thresholds) {
        m <- metrics_list[i - first_metrics_thresholds_offset]
        if( length(m) > 1) m <- m[[1]]
        header <- paste(header, "for max", m, "@ threshold =", t)
      } else {
        header <- paste(header, "@ threshold =", row$threshold)
      }
      attr(tbl, "header") <- header
      attr(tbl, "formats") <- fmts
      oldClass(tbl) <-