R/server.R

Defines functions h2o_xgboost_available h2o_get_frame h2o_get_model h2o_remove_all h2o_remove h2o_running h2o_end h2o_start

Documented in h2o_end h2o_get_frame h2o_get_model h2o_remove h2o_remove_all h2o_running h2o_start h2o_xgboost_available

#' Utility functions for interacting with the h2o server
#'
#' @param verbose Print out the message if no cluster is available.
#' @param id Model or frame id.
#' @examples
#' \dontrun{
#' if (!h2o_running()) {
#'   h2o_start()
#' }
#' }
#' @rdname h2o-server
#' @export
h2o_start <- function() {
  if (has_java()) {
    rlang::warn("JAVA not found, H2O may take minutes trying to connect.")
  }
  res <- utils::capture.output(h2o::h2o.no_progress(
    h2o::h2o.init()
  ), "output")
  invisible(res)
}

#' @rdname h2o-server
#' @export
h2o_end <- function() {
  h2o::h2o.shutdown(prompt = FALSE)
}

#' @rdname h2o-server
#' @export
h2o_running <- function(verbose = FALSE) {
  res <- try(h2o::h2o.clusterIsUp(), silent = TRUE)
  if (inherits(res, "try-error")) {
    if (verbose) {
      msg <- as.character(res)
      rlang::inform(msg)
    }
    res <- FALSE
  }
  res
}

#' @rdname h2o-server
#' @export
h2o_remove <- function(id) {
  h2o::h2o.rm(id)
}

#' @rdname h2o-server
#' @export
h2o_remove_all <- function() {
  h2o::h2o.removeAll()
}

#' @rdname h2o-server
#' @export
h2o_get_model <- function(id) {
  res <- eval_silently(h2o::h2o.no_progress(h2o::h2o.getModel(id)))
  if (is.null(res)) {
    rlang::abort("Model id does not exist on the h2o server.")
  }
  res
}

#' @rdname h2o-server
#' @export
h2o_get_frame <- function(id) {
  res <- eval_silently(h2o::h2o.no_progress(h2o::h2o.getFrame(id)))
  if (!is.null(res)) {
    res
  }
}

#' @rdname h2o-server
#' @export
h2o_xgboost_available <- function() {
  "XGBoost" %in% h2o::h2o.list_core_extensions()
}

Try the agua package in your browser

Any scripts or data that you put into this service are public.

agua documentation built on June 7, 2023, 5:07 p.m.