Nothing
####################################################################
#' Calculate predictions of h2o Models
#'
#' \code{h2o_predict_MOJO} lets the user predict using the h2o .zip file
#' containing the MOJO files. Note that it works with the files
#' generated when using the function export_results()
#'
#' @family Machine Learning
#' @family H2O
#' @param df Dataframe. Data to pass to the model.
#' @param model_path Character. Relative path of directory
#' where your zip model file is. If multiple zip files are found,
#' first one found will be used.
#' @param method Character. One of "mojo" or "json".
#' @param batch Integer. Run n batches at a time for "json" method.
#' @return data.frame with predicted results.
#' @export
#' @rdname h2o_predict
h2o_predict_MOJO <- function(df, model_path, method = "mojo", batch = 300) {
quiet(h2o.init(nthreads = -1, port = 54321))
files <- list.files(model_path)
file <- files[endsWith(files, ".zip")][1]
zip <- paste0(model_path, "/", file)
# message(">>> MOJO file: ", zip)
if (method == "mojo") {
df <- .quiet_h2o(as.h2o(df))
mojo_model <- .quiet_h2o(h2o.import_mojo(zip))
output <- .quiet_h2o(as.data.frame(h2o.predict(mojo_model, df)))
}
if (method == "json") {
df <- as.data.frame(df)
df <- mutate_if(df, is.logical, as.character)
aux <- ceiling(nrow(df) / batch)
df$aux <- rep(1:aux, each = batch)[seq_len(nrow(df))]
output <- NULL
for (i in 1:aux) {
dfi <- select(df[df$aux == i, ], -.data$aux)
json <- toJSON(dfi)
size <- nchar(json)
if (size > 250000) {
stop(paste(
"JSON batch is too long. Please, try with a smaller 'batch' parameter.",
"Suggested size:", round(batch * 235000 / size)
))
}
res <- h2o.predict_json(zip, json, labels = TRUE)
if ("error" %in% names(res)) {
message("\nERROR: There was an issue with one of the inputs to predict...")
writeLines(res$error)
break
}
output <- rbind(output, res)
if (aux > 1) statusbar(i, aux, i * batch)
}
if ("classProbabilities" %in% names(output)) {
aux <- .flatten_list(output$classProbabilities, quiet = TRUE)
colnames(aux) <- output$responseDomainValues[[1]]
output <- cbind(output[, c(1, 2)], aux)
}
}
return(as_tibble(output))
}
####################################################################
#' H2O Predict using Binary file
#'
#' \code{h2o_predict_binary} lets the user predict using the h2o binary file.
#' Note that it works with the files generated when using the
#' function export_results(). Recommendation: use the
#' h2o_predict_MOJO() function when possible - it let's you change
#' h2o's version without problem.
#'
#' @param df Dataframe. Data to insert into the model.
#' @param model_path Character. Relative model path directory or zip file.
#' @param sample Integer. How many rows should the function predict?
#' @return vector with predicted results.
#' @export
#' @rdname h2o_predict
h2o_predict_binary <- function(df, model_path, sample = NA) {
message("Use of h2o_predict_MOJO instead highly recommended!")
quiet(h2o.init(nthreads = -1, port = 54321))
if (!right(model_path, 4) == ".zip") {
binary <- paste(model_path, gsub(".*-", "", model_path), sep = "/")
} else {
binary <- model_path
}
model <- h2o.loadModel(binary)
if (!is.na(sample)) df <- df[1:sample, ]
score_binary <- as.vector(predict(model, as.h2o(df))[, 3])
return(score_binary)
}
####################################################################
#' H2O Predict using H2O Model Object
#'
#' \code{h2o_predict_model} lets the user get scores from a H2O Model Object.
#'
#' @param df Dataframe/Vector. Data to insert into the model.
#' @param model h2o model Object
#' @return data.frame with predicted results.
#' @export
#' @rdname h2o_predict
h2o_predict_model <- function(df, model) {
as.data.frame(predict(model, as.h2o(df)))
}
####################################################################
#' H2O Predict using API Service
#'
#' \code{h2o_predict_API} lets the user get the score from an API service
#'
#' @param df Dataframe/Vector. Data to insert into the model.
#' @param api Character. API URL.
#' @param exclude Character. Name of the variables to exclude.
#' @return vector with predicted results.
#' @export
#' @rdname h2o_predict
h2o_predict_API <- function(df, api, exclude = "tag") {
post <- function(df, api) {
df <- df %>%
removenacols() %>%
select(-one_of(exclude))
x <- POST(
api,
add_headers("Content-Type" = "application/json"),
body = as.list(df),
encode = "json"
)
content(x)$probabilityToOne
}
batch <- NULL
for (i in seq_len(nrow(df))) {
x <- df[i, ]
score <- post(x, api)
batch <- rbind(batch, score)
}
as.vector(batch)
}
.flatten_list <- function(x, quiet = FALSE) {
n <- length(x)
for (i in 1:n) {
if (i == 1) ret <- NULL
values <- unlist(x[[i]])
aux <- data.frame(t(values))
ret <- suppressWarnings(bind_rows(ret, aux))
if (n > 500 && !quiet) statusbar(i, n, i)
if (i == n) ret <- as_tibble(ret)
}
return(ret)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.