Кеширование в R/Shiny

Ответ 1

Предполагая, что вы используете ggplot (который с Shiny я бы поставил, это справедливое предположение).

• Создайте пустой список для хранения вашего grob, скажем Plist.
• Когда пользователь запрашивает график, создайте хеш-строку на основе блестящих входов
• Проверьте, сохранен ли граф, например hash %in% names(Plist)
• Если да, откройте этот график
• Если нет, сгенерируйте граф, сохраните grob в списке, назовите элемент хешем, например Plist[hash] <- new_graph

Ответ 2

Изменить

Кэширование изображений, созданных с помощью renderPlot()/plotOutput(), поддерживается начиная с версии 1.2.0.

• заметки о выпуске: https://shiny.rstudio.com/reference/shiny/1.2.0/upgrade.html

• документация по функциям https://shiny.rstudio.com/reference/shiny/1.2.0/renderCachedPlot.html.

Приведенное ниже решение ведет себя подобно следующему использованию renderCachedPlot().

output$plot <- renderCachedPlot(
  expr = {
    histfaithful(bins = input$bins, col = input$col) 
  },
  cache = diskCache()
)

renderCachedPlot() позволяет кэшировать в памяти и на диске с разумными значениями по умолчанию. Правила для генерации ключей хеша могут быть настроены и по умолчанию digest::digest() используется для всех реактивных выражений, которые появляются в expr.

Приведенное ниже решение демонстрирует, как подмножество этих функций (кэширование на диске) может быть реализовано с помощью блестящего модуля. Основная стратегия заключается в использовании

• digest::digest() для создания ключей кэша на основе аргументов, отправленных в функцию построения
• do.call() для передачи аргументов в функцию plot, если ключ, созданный из digest(), не означает, что изображение уже кэшировано
• grDevices::png() захватить изображение из звонка на do.call() и добавить его в кеш
• shiny::renderImage() для обслуживания изображений из кэша

Оригинальный ответ

Хотя оба ответа на этот вопрос очень хорошие, я хотел бы добавить еще один, используя блестящие модули. Следующий модуль принимает в качестве входных данных графическую функцию и реактивную версию аргументов. В конце концов do.call(plotfun, args()) используется для создания сюжета.

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"))
}

Как мы видим, модуль удаляет созданные файлы изображений, если это необходимо, и дает возможность использовать пользовательский каталог для кэширования в случае, если необходимо постоянное кэширование (как в моем реальном случае использования).

В качестве примера использования я буду использовать пример hist(faithful[, 2]) так же, как 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))
    )
  }
)

Ответ 3

Ответ от Ricardo Saporta очень хороший, и я использовал для решения аналогичной проблемы, но я также хотел добавить решение для кода.

Для кэширования я использовал digest::digest(), где я только что подал список параметров для этого конкретного графа этой функции, чтобы создать хэш-строку. Первоначально я думал, что мне нужно будет извлечь хэш-строку из observe(), а затем использовать stat if/else, чтобы определить, следует ли отправить его в renderImage() или renderPlot() на основе того, было ли ранее создано изображение. Я немного сработал с этим, а затем наткнулся только на renderImage(). Это не идеальная замена изображения, но более чем достаточно близкая для целей этой демонстрации.

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')
    )
  )
)

и 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)
}