R/cloudstan.R

In uroshercog/cloudstan-r: Cloudstan R client library

exec_bin <- function(args = c()) {
  rsp <- exec_bin_raw(args)

  # Figure out if error: exit code is not zero
  if(rsp$status != 0) {
    c("ERROR", jsonlite::fromJSON(rsp$stdout)$error)
  } else {
    c("SUCCESS", jsonlite::fromJSON(rsp$stdout)$success)
  }
}

exec_bin_raw <- function(args = c(), stdout_cb = NULL) {
  if(!bin_exists()) {
    message("Installing the Cloudstan CLI.")
    install(install_local = askYesNo("Do you also want to install cmdstanr for offline usage?"))
  }

  args = c("--json", "--non-interactive", args)

  processx::run(
    bin_path(),
    args = args,
    spinner = TRUE,
    error_on_status = FALSE,
    stdout_line_callback = stdout_cb
  )
}

fetch_and_print_table <- function(cmd) {
  rsp <- exec_bin(cmd)

  if(rsp[1] == "ERROR") {
    stop(paste(rsp$code, ": ", rsp$message))
  } else {
    df <- as.data.frame(rsp[2]$data)
    colnames(df) <- rsp[3]$headers

    print(df, right = FALSE)
  }
}

#' Fetch and display a table of all Stan data the user has uploaded.
#'
#' @export
#'
list_data <- function(){
  fetch_and_print_table(c("data", "list"))
}

#' Fetch and display a table of all Stan models the user has compiled.
#'
#' @export
#'
list_models <- function() {
  fetch_and_print_table(c("models", "list"))
}

#' Fetch and display a table of all Stan sampling the user created.
#'
#' @export
#'
list_sampling_results <- function() {
  fetch_and_print_table(c("samplings", "list"))
}

#' Delete a compiled model. This also removes any bound sampling results.
#'
#' @param id ID of the model to delete.
#'
#' @export
#'
delete_model <- function(id) {
  ok <- ask_for_confirmation("Do you really want to delete the model? This action is irreversible. Note deleting the model will also cause any sampling results of the model to be deleted as well.")
  if (ok) {
    rsp <- exec_bin(c("models", "delete", id))
    if(rsp[1] == "ERROR") {
      stop(paste(rsp$code, ": ", rsp$message))
    } else {
      message("Model marked for deletion. It might take a while before the model and sampling results are actually removed. You can keep track of the state by listing models or sampling results.")
    }
  } else {
    message("Action canceled, model not deleted.")
  }
}

#' Delete uploaded data. This also removes any bound samplings.
#'
#' @param id ID of the data to delete.
#'
#' @export
#'
delete_data <- function(id) {
  ok <- ask_for_confirmation("Do you really want to delete the data? This action is irreversible. Note deleting data will also cause any sampling results of the data to be deleted as well.")
  if(ok) {
    rsp <- exec_bin(c("data", "delete", id))
    if (rsp[1] == "ERROR") {
      stop(paste(rsp$code, ": ", rsp$message))
    } else {
      message("Data marked for deletion. It might take a while before the data and sampling results are actually removed. You can keep track of the state by listing data or sampling results.")
    }
  } else {
    message("Action canceled, data not deleted.")
  }
}

#' Delete sampling.
#'
#' @param id ID of the sampling to delete.
#'
#' @export
#'
delete_sampling_results <- function (id) {
  ok <- ask_for_confirmation("Do you really want to delete the sampling results? This action is irreversible.")
  if (ok) {
    rsp <- exec_bin(c("samplings", "delete", id))
    if(rsp[1] == "ERROR") {
      stop(paste(rsp$code, ": ", rsp$message))
    } else {
      message("Sampling results marked for deletion. It might take a while before the sampling results are actually removed. You can keep track of the state by listing sampling results.")
    }
  } else {
    message("Action canceled, sampling results not deleted.")
  }
}

#' Load results from a previously completed
#' sampling.
#'
#' @param id ID of the sampling results to load.
#' @return cmdstanr fit object
#'
#' @export
#'
load_sampling_results <- function(id) {
  message("* Downloading sampling results.")
  rsp <- exec_bin(c("samplings", "results", "--untar", id))

  if(rsp[1] == "ERROR") {
    stop(paste(rsp$code, ": ", rsp$message))
  }

  message("* Sampling results successfully downloaded and parsed.")

  resultFilesDirPath <- rsp[2]$path
  files <- list.files(path = resultFilesDirPath, full.names = TRUE)
  cmdstanr::as_cmdstan_fit(files = files)
}

#' Load source from a previously uploaded data.
#'
#' @param id ID of the data to load.
#' @return Vector of data.
#'
#' @export
#'
load_data <- function(id) {
  message("* Loading remote data.")
  rsp <- exec_bin(c("data", "get", id))

  if(rsp[1] == "ERROR") {
    stop(paste(rsp$code, ": ", rsp$message))
  }

  message("* Data successfully downloaded and parsed.")

  jsonlite::fromJSON(rsp[3]$source)
}

#' Load source from a previously uploaded Stan source code.
#'
#' @param id ID of the model to load.
#' @return Stan source code.
#'
#' @export
#'
load_model <- function(id) {
  message("* Loading remote model source code.")
  rsp <- exec_bin(c("models", "get", id))

  if(rsp[1] == "ERROR") {
    stop(paste(rsp$code, ": ", rsp$message))
  }

  message("* Model source code successfully downloaded.")
  rsp$source
}