R/cache.R

In patelm9/cave: Package Management Package

#' Cache an object for retrieval later
#' @description This function uses the R.cache package, but creates a key automatically based on the present R script and the object name. The directory for the cache also by default is in the set path with a subdirectory that matches the name of the working directory.
#' @param object object to cache.
#' @importFrom R.cache saveCache
#' @export

cache_object <-
  function(object) {
    .Deprecated()
    object_name <- deparse(substitute(object))
    key <- use_cache_key(object_name = object_name)

    print(key)

    dirs <- strip_fn(getwd())
    x <- R.cache::saveCache(
      object = object,
      key = key,
      dirs = dirs
    )

    secretary::typewrite_bold("Object cached to", x, ".")
  }








#' Create the key for caching
#' @description The list object that serves as a key for the caching functions of the R.cache package. This function differs from use_key in that this one is used to first save a virgin object while the use_key is used to retrieve an object.
#' @export

cut_cache_key <-
  function(object) {
    return(
      list(
        script_path = present_script_path(),
        object_name = deparse(substitute(object))
      )
    )
  }





#' Load a cached object
#' @description A cached object is retrieved based on a key generated by the path to the present R script, object name, and the working directory.
#' @return cached object. NULL if no such cache exists. Console messages also accompany the output
#' @param remove_stale_cache If TRUE, removes all files older than 180 days from the cache.
#' @seealso
#'  \code{\link[R.cache]{getCachePath}},\code{\link[R.cache]{loadCache}}
#'  \code{\link[purrr]{map}},\code{\link[purrr]{set_names}},\code{\link[purrr]{keep}}
#'  \code{\link[secretary]{typewrite_bold}}
#' @rdname load_cached_object
#' @export
#' @importFrom R.cache getCachePath loadCache
#' @importFrom dplyr %>%
#' @importFrom purrr map set_names keep
#' @importFrom secretary typewrite_bold

load_cached_object <-
  function(object_name, remove_stale_cache = TRUE) {
    if (remove_stale_cache == TRUE) {
      cache_files <- list.files(paste0(R.cache::getCachePath(), "/", strip_fn(getwd())), full.names = TRUE)
      cache_files %>%
        purrr::map(file.mtime) %>%
        purrr::set_names(cache_files) %>%
        purrr::map(function(x) difftime(Sys.time(), x, units = "days")) %>%
        purrr::keep(function(x) x > 180) %>%
        names() %>%
        file.remove()
    }

    key <- use_cache_key(object_name = object_name)
    print(key)
    x <- R.cache::loadCache(
      key = key,
      dirs = strip_fn(getwd()),
      onError = "error"
    )
    if (!is.null(x)) {
      secretary::typewrite_bold("Cache loaded")
      return(x)
    } else {
      secretary::typewrite_bold("Cache does not exist for this object based on the present script path, working directory, and object name.")
      return(x)
    }
  }





#' Create the key for caching
#' @description The list object that serves as a key for the caching functions of the R.cache package. This function differs from cut_key in that this one is used to retrieve a cached object if it exists.
#' @export

use_cache_key <-
  function(object_name) {
    return(
      list(
        script_path = present_script_path(),
        object_name = object_name
      )
    )
  }