caching plots in R/Shiny
Assuming you are using ggplot
(which with Shiny, I would bet is a fair assumption).
- Create an empty list to store your grob, say
Plist
. - When a user request a graph, create a string hash based on the shiny inputs
- Check if the graph is already saved, eg
hash %in% names(Plist)
- If yes, serve up that graph
- If no, generate the graph, save the grob to the list, name the element by the hash, eg,
Plist[hash] <- new_graph
Edit
Caching of images created with renderPlot()/plotOutput()
is supported since shiny 1.2.0.
release notes: https://shiny.rstudio.com/reference/shiny/1.2.0/upgrade.html
function documentation https://shiny.rstudio.com/reference/shiny/1.2.0/renderCachedPlot.html.
The solution below behaves similar to the following usage of renderCachedPlot()
.
output$plot <- renderCachedPlot(
expr = {
histfaithful(bins = input$bins, col = input$col)
},
cache = diskCache()
)
renderCachedPlot()
allows caching in memory and on disk with sensible defaults. The rules for generating hash keys can be customized and by default digest::digest()
is used for all reactive expressions that appear in expr
.
The solution below demonstrates how a subset of these features (caching on disk) can be implemented with a shiny module. The basic strategy is to use
digest::digest()
to create cache keys based on arguments sent to a plot functiondo.call()
to pass the arguments to the plot function unless the key created fromdigest()
signifies that the image is already cachedgrDevices::png()
to capture an image from the call todo.call()
and add it to the cacheshiny::renderImage()
to serve images from the cache
Original answer
Although both answers to this question are very good, I wanted do add another one using shiny modules. The following module takes a plotfunction and a reactive version of it's arguments as inputs. In the end do.call(plotfun, args())
is used to create the plot.
library(shiny)
cachePlot <- function(input, output, session, plotfun, args, width = 480, height = 480,
dir = tempdir(), prefix = "cachedPlot", deleteonexit = TRUE){
hash <- function(args) digest::digest(args)
output$plot <- renderImage({
args <- args()
if (!is.list(args)) args <- list(args)
imgpath <- file.path(dir, paste0(prefix, "-", hash(args), ".png"))
if(!file.exists(imgpath)){
png(imgpath, width = width, height = height)
do.call(plotfun, args)
dev.off()
}
list(src = imgpath)
}, deleteFile = FALSE)
if (deleteonexit) session$onSessionEnded(function(){
imgfiles <- list.files(dir, pattern = prefix, full.names = TRUE)
file.remove(imgfiles)
})
}
cachePlotUI <- function(id){
ns <- NS(id)
imageOutput(ns("plot"))
}
As we can see, the module deletes the image files created if needed and gives the option to use a custom caching-directory in case persistent caching is needed (as it is in my actual usecase).
For a usage example, I'll use the hist(faithful[, 2])
example just like Stedy.
histfaithful <- function(bins, col){
message("calling histfaithful with args ", bins, " and ", col)
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = bins + 1)
hist(x, breaks = bins, col = col, border = 'white')
}
shinyApp(
ui = fluidPage(
inputPanel(
sliderInput("bins", "bins", 5, 30, 10, 1),
selectInput("col", "color", c("blue", "red"))
),
cachePlotUI("cachedPlot")
),
server = function(input, output, session){
callModule(
cachePlot, "cachedPlot", histfaithful,
args = reactive(list(bins = input$bins, col = input$col))
)
}
)
The answer from Ricardo Saporta is very good and what I used to solve a similar problem, but I wanted to add a code solution as well.
For caching I used digest::digest()
where I just fed a list of the parameters for that particular graph to that function to create a hash string. I initially thought that I would have to extract the hash string from observe()
and then use an if/else statment to determine if I should send it to renderImage()
or renderPlot()
based on if the image had previously been created. I flailed with this for a while and then stumbled upon just using renderImage()
. Its not a perfect image substitution but more than close enough for the purposes of this demo.
ui.R
library(shiny)
fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 25),
selectInput("plot_color", "Barplot color",
c("green"="green",
"blue"="blue"))
),
mainPanel(
plotOutput("distPlot", width='100%', height='480px')
)
)
)
and server.R
library(shiny)
function(input, output) {
base <- reactive({
fn <- digest::digest(c(input$bins, input$plot_color))
fn})
output$distPlot <- renderImage({
filename <- paste0(base(), ".png")
if(filename %in% list.files()){
list(src=filename)
} else {
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
png(filename)
hist(x, breaks = bins, col = input$plot_color, border = 'white')
dev.off()
list(src=filename)
}
}, deleteFile = FALSE)
}