From 0f9346ead523347997008326c77e6f596aa02c41 Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Thu, 15 Mar 2018 16:37:34 -0500 Subject: [PATCH] Add different scoping levels for plotCache --- R/render-plot.R | 58 +++++++++++++++++++++++++++++++++++------------- R/server.R | 6 ++++- man/plotCache.Rd | 17 ++++++-------- 3 files changed, 55 insertions(+), 26 deletions(-) diff --git a/R/render-plot.R b/R/render-plot.R index 785e173f2..3aaf9a299 100644 --- a/R/render-plot.R +++ b/R/render-plot.R @@ -981,15 +981,13 @@ find_panel_ranges <- function(g, pixelratio, res) { #' #' Creates a read-through cache for plots. The plotting logic is provided as #' plotFunc, a function that can have any number/combination of arguments; the -#' return value of plotCache is a function that should be used in the place of -#' plotFunc. Each unique combination of inputs will be cached to disk in the -#' location specified by cachePath. +#' return value of \code{plotCache()} is a function that should be used in the +#' place of plotFunc. Each unique combination of inputs will be cached to disk +#' in the location specified by \code{cachePath}. #' -#' The invalidationExpr expression will be monitored and whenever it is +#' The \code{invalidationExpr} expression will be monitored and whenever it is #' invalidated, so too is the cache invalidated (the contents are erased). #' -#' @param cacheId An identifier for this cache; by default, will be incorporated -#' into the cache directory path. #' @param invalidationExpr Any expression or block of code that accesses any #' reactives whose invalidation should cause cache invalidation. This #' typically would be an expression that indicates that the source data has @@ -1013,12 +1011,46 @@ find_panel_ranges <- function(g, pixelratio, res) { #' \code{quote()}. #' #' @export -plotCache <- function(cacheId, invalidationExpr, width, height, res = 72, +plotCache <- function(invalidationExpr, width, height, res = 72, plotFunc, - cachePath = file.path(tempdir(), cacheId), + cachePath = NULL, invalidation.env = parent.frame(), - invalidation.quoted = FALSE) { + invalidation.quoted = FALSE, + session = getDefaultReactiveDomain() +) { + # If user didn't supply cachePath, automatically determine it. + if (is.null(cachePath)) { + if (!is.null(session)) { + # Case 1: scope to session + cacheScopePath <- file.path(tempdir(), paste0("shinysession-", session$token)) + + } else if (!is.null(getShinyOption("appToken"))) { + # Case 2: scope to app + cacheScopePath <- file.path(tempdir(), paste0("shinyapp-", getShinyOption("appToken"))) + + } else { + # Case 3: scope to current R process + cacheScopePath <- file.path(tempdir(), "shiny") + } + + cachePath <- file.path(cacheScopePath, createUniqueId(8)) + + # Remove the cache directory when it's no longer needed. + reg.finalizer(environment(), function(e) { + unlink(cachePath, recursive = TRUE) + + # If cacheScopePath is empty, remove it. + siblingPaths <- setdiff(dir(cacheScopePath, all.files = TRUE), c(".", "..")) + if (length(siblingPaths) == 0) { + file.remove(cacheScopePath) + } + }) + } + + if (dir.exists(cachePath)) { + unlink(cachePath, recursive = TRUE) + } dir.create(cachePath, recursive = TRUE, mode = "0700") if (!invalidation.quoted) { @@ -1026,25 +1058,21 @@ plotCache <- function(cacheId, invalidationExpr, width, height, res = 72, } observeEvent(invalidationExpr, event.env = invalidation.env, event.quoted = TRUE, { - # TODO: robustify if (dir.exists(cachePath)) { - file.rename(cachePath, paste0(cachePath, ".gone")) + unlink(cachePath, recursive = TRUE) } dir.create(cachePath, recursive = TRUE, mode = "0700") - unlink(paste0(cachePath, ".gone"), recursive = TRUE) }) function(...) { + browser() args <- list(...) key <- paste0(digest::digest(args), ".png") filePath <- file.path(cachePath, key) if (!file.exists(filePath)) { - message("Cache miss") plotPNG(function() { do.call("plotFunc", args) }, filename = filePath, width = width, height = height, res = res) - } else { - message("Cache hit") } filePath } diff --git a/R/server.R b/R/server.R index 3258d6de8..faba8c167 100644 --- a/R/server.R +++ b/R/server.R @@ -579,12 +579,16 @@ runApp <- function(appDir=getwd(), .globals$running <- FALSE }, add = TRUE) - # Enable per-app Shiny options + # Enable per-app Shiny options, for shinyOptions() and getShinyOption(). oldOptionSet <- .globals$options on.exit({ .globals$options <- oldOptionSet },add = TRUE) + # A unique identifier associated with this run of this application. It is + # shared across sessions. + shinyOptions(appToken = createUniqueId(8)) + # Make warnings print immediately # Set pool.scheduler to support pool package ops <- options( diff --git a/man/plotCache.Rd b/man/plotCache.Rd index ad11954cc..e73e4d2f6 100644 --- a/man/plotCache.Rd +++ b/man/plotCache.Rd @@ -4,14 +4,11 @@ \alias{plotCache} \title{Disk-based plot cache} \usage{ -plotCache(cacheId, invalidationExpr, width, height, res = 72, plotFunc, - cachePath = file.path(tempdir(), cacheId), - invalidation.env = parent.frame(), invalidation.quoted = FALSE) +plotCache(invalidationExpr, width, height, res = 72, plotFunc, + cachePath = NULL, invalidation.env = parent.frame(), + invalidation.quoted = FALSE, session = getDefaultReactiveDomain()) } \arguments{ -\item{cacheId}{An identifier for this cache; by default, will be incorporated -into the cache directory path.} - \item{invalidationExpr}{Any expression or block of code that accesses any reactives whose invalidation should cause cache invalidation. This typically would be an expression that indicates that the source data has @@ -43,11 +40,11 @@ that is stored in a variable; to do so, it must be quoted with \description{ Creates a read-through cache for plots. The plotting logic is provided as plotFunc, a function that can have any number/combination of arguments; the -return value of plotCache is a function that should be used in the place of -plotFunc. Each unique combination of inputs will be cached to disk in the -location specified by cachePath. +return value of \code{plotCache()} is a function that should be used in the +place of plotFunc. Each unique combination of inputs will be cached to disk +in the location specified by \code{cachePath}. } \details{ -The invalidationExpr expression will be monitored and whenever it is +The \code{invalidationExpr} expression will be monitored and whenever it is invalidated, so too is the cache invalidated (the contents are erased). }