11

只是想知道是否有技巧/方法可以缓存通过我们闪亮的应用程序生成的图。

背景：

我们正在进行一些计算密集型计算，最终产生了一个绘图。我已经缓存（使用 memoise）完成的计算，全局闪亮，但渲染绘图仍需要大约 0.75 秒。我只是想知道我们是否可以通过删除渲染图像所需的时间来减少该时间，以及是否已经有巧妙的方法可以做到这一点。

更多细节：

我正在使用网格来创建绘图（在这种情况下为热图。理想情况下，希望缓存是基于磁盘的，因为将绘图存储在内存中不会扩大规模。

谢谢！-阿比

4

3 回答 3

6

假设您正在使用ggplot（我敢打赌，这是一个公平的假设）。

  1. 创建一个空列表来存储您的 grob，例如Plist.
  2. 当用户请求图表时，根据闪亮的输入创建字符串哈希
  3. 检查图表是否已经保存，例如 hash %in% names(Plist)
  4. 如果是，请提供该图表
  5. 如果否，则生成图形，将 grob 保存到列表中，通过哈希命名元素，例如， Plist[hash] <- new_graph
于 2014-06-12T20:04:40.027 回答
6

编辑

renderPlot()/plotOutput()从闪亮的 1.2.0 开始支持缓存创建的图像。

以下解决方案的行为类似于以下renderCachedPlot().

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

renderCachedPlot()允许以合理的默认值缓存在内存和磁盘上。生成哈希键的规则可以自定义，默认情况下digest::digest()用于所有出现在expr.

下面的解决方案演示了如何使用闪亮的模块来实现这些功能的子集（磁盘上的缓存）。基本策略是使用

  • digest::digest()根据发送到绘图函数的参数创建缓存键
  • do.call()将参数传递给绘图函数，除非创建的键digest()表示图像已被缓存
  • grDevices::png()从调用中捕获图像do.call()并将其添加到缓存中
  • shiny::renderImage()从缓存中提供图像

原始答案

虽然这个问题的两个答案都很好，但我想使用闪亮的模块添加另一个答案。以下模块将 plotfunction 和它的参数的反应版本作为输入。最后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))
    )
  }
)
于 2018-01-27T12:47:42.913 回答
3

Ricardo Saporta 的答案非常好，我曾经解决过类似的问题，但我也想添加一个代码解决方案。

对于缓存，我使用digest::digest()了我刚刚将该特定图形的参数列表提供给该函数以创建哈希字符串的位置。我最初认为我必须从中提取哈希字符串observe()，然后使用 if/else 语句来确定是否应该将其发送到renderImage()或renderPlot()基于图像之前是否已创建。我为此挣扎了一段时间，然后偶然发现只是使用renderImage(). 它不是一个完美的图像替换，但对于这个演示来说已经足够接近了。

用户界面

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

和服务器.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)
}
于 2017-09-09T15:10:44.530 回答