function caching function for R

r_cache.R

####~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
### Cache (memoization) utilities
###
### Purpose
###  * Functions to save the output of time consuming functions to memory and
###    return results quickly if we already have the answers
### 
### Notes: Standard usage would go like this
### FunctionName <- function(){
###   args          <- c(as.list(environment()), list())
###   cached.result <- CheckCache("FunctionName", args)
###   if(!is.null(cached.result)) return(cached.result)
###   
###   [body of function which produces "output" object]
###   
###   SaveCache(output, fn.name="FunctionName", args = args )
###   return(output) 
### }
###
### Primary Creator(s): Sam Swift ([email protected])
####~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

library(digest)

if(!exists("cache")){
  cache <- new.env(parent = .GlobalEnv)
}

CheckCache <- function(fn.name, args, verbose = FALSE){
  hash <- paste(fn.name, digest(args), sep="_")
  if(verbose) message(Sys.time(), " CheckCache, checking for ", hash)
  if(exists(hash, envir=cache)){
    if(verbose) message(Sys.time(), " CheckCache, cache found, returning ", hash)
    return(get(x=hash, envir = cache))
  } else {
    message(Sys.time(), " CheckCache, no cache for ", hash)
    return(NULL)
  }
}

SaveCache <- function(obj, fn.name, args, verbose = FALSE){
  hash <- paste(fn.name, digest(args), sep="_")
  assign(x = hash, value = obj, envir = cache)
  message(Sys.time(), " SaveCache, saving ", hash)
  return(exists(hash, envir= cache))
}

UnCache <- function(fn.name = NULL, all = FALSE){
  if(all){
    rm(list = ls(envir = cache), envir = cache)    
  } else if(!is.null(fn.name)){
    rm(list = ls(envir   = cache, 
                 pattern = paste(fn.name,"_", sep="")),
       envir = cache)
  } else {
    message(Sys.time(), " UnCache, nothing specified, so nothing uncached. Specify either a function name or set all = TRUE")
  } 
}