R/cached_call.R

In proyais/shinyCache: Create a simple cache for variables inside Shiny applications.

#' Execute a function or retrieve values from a cache
#'
#' \code{cache_call} returns a function call or retrieves a value stored in a
#'   cache in order to speed up shiny apps.
#'
#' This function identifies a value based on the parameters passed on to a
#'   function, a prefix and extra objects the user decides to use. This
#'   function uses reactiveValues to create a hash dictionary from which to
#'   retrieve previously executed funtions.
#'
#' @param fn A function to call if the value is not cached
#' @param cache A reactiveValues object to serve as a cache storage
#' @param cache_params Named list of parameters to pass on to fn. These
#'   parameters will identify the cached object.
#' @param non_cache_params Named list of parameters to pass on to fn
#'   without affecting the identity of the cached item.
#' @param prefix A prefix to add to the hash of a cached object. Serves the
#'   purpose of allowing users to more easily identify cached objects.
#' @param cache_depends Extra object that affects the identity of an object.
#' @param custom_id Use a custom id instead of a hash generated by
#'   cache_params and cache_depends
#'
#' @examples
#' cache <- reactiveValues()
#'
#' output$table <- renderDataTable({
#'   cache_call(
#'     fn = long_computation,
#'     cache = cache,
#'     cache_params = list(arg1 = user_input),
#'     non_cache_params = list(data = mtcars),
#'     prefix = "table"
#'   )
#' })
#'
#' @export

cache_call <- function(fn, cache, cache_params = list(),
                       non_cache_params = NULL, prefix = NULL,
                       cache_depends = NULL, custom_id = NULL) {

  if (class(fn) != "function") stop ("fn is not a function.")
  if (class(cache) != "reactivevalues") stop("cache is not reactivevalues.")

  cache_id <- custom_id
  if (is.null(custom_id)) {
    cache_id <- digest::digest(
      object = list(cache_params = cache_params, cache_depends = cache_depends),
      algo = "sha256",
      seed = 1
    )
  }

  if (!is.null(prefix)) cache_id <- paste(prefix, cache_id, sep = "_")

  if (!is.null(non_cache_params)) {
    cache_params <- append(non_cache_params, cache_params)
  }

  check_cache <- cache_id %in% names(cache)

  if (check_cache) return(cache[[cache_id]])
  if (!check_cache) {
    value_to_cache <- do.call(
      what = fn,
      args = cache_params
    )
    cache[[cache_id]] <- value_to_cache
    return(value_to_cache)
  }

}