在R/s中缓存绘图

在R/s中缓存绘图,r,shiny,shiny-server,R,Shiny,Shiny Server,我只是想知道是否有一些技巧/方法可以缓存通过我们闪亮的应用程序生成的绘图 背景: 我们正在做一些计算密集型的计算,最终得到一个绘图。我已经在缓存(使用memoise)完成的计算,全局以闪亮的颜色显示,但渲染一个绘图仍然需要大约0.75秒。我只是想知道,我们是否可以通过减少渲染图像所需的时间来减少这一时间,以及是否已经有一些巧妙的方法可以做到这一点 更多详情: 我正在使用网格创建绘图(本例中为热图)。理想情况下,我希望缓存基于磁盘,因为在内存中存储绘图不会放大 谢谢! -Abhi假设您使用的是gg

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

背景:

我们正在做一些计算密集型的计算,最终得到一个绘图。我已经在缓存(使用memoise)完成的计算,全局以闪亮的颜色显示,但渲染一个绘图仍然需要大约0.75秒。我只是想知道,我们是否可以通过减少渲染图像所需的时间来减少这一时间,以及是否已经有一些巧妙的方法可以做到这一点

更多详情:

我正在使用网格创建绘图(本例中为热图)。理想情况下,我希望缓存基于磁盘,因为在内存中存储绘图不会放大

谢谢!
-Abhi

假设您使用的是
ggplot
(我敢打赌,对于闪亮来说,这是一个公平的假设)

  • 创建一个空列表来存储你的grob,比如说
    Plist
  • 当用户请求图形时,根据输入创建字符串哈希
  • 检查图形是否已保存,例如%names(Plist)中的
    哈希%
  • 如果是,请提供该图表

  • 如果没有,生成图形,将grob保存到列表中,用哈希值命名元素,例如,
    Plist[hash]Ricardo Saporta的答案非常好,我曾经解决过类似的问题,但我也想添加一个代码解决方案

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

    用户界面

    和服务器.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)
    }
    
    库(闪亮)
    功能(输入、输出){
    基本编辑
    自1.2.0以来,支持缓存使用
    renderPlot()/plotOutput()
    创建的图像

    • 发行说明:

    • 函数文档

    下面的解决方案的行为类似于
    renderCachedPlot()
    的以下用法

    正如我们所看到的,该模块删除了在需要时创建的图像文件,并提供了在需要持久缓存时使用自定义缓存目录的选项(就像在我的实际用例中一样)

    作为一个用法示例,我将像Stedy一样使用
    hist(忠实的[2])
    示例

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

    histfamily感谢您的快速回复。我正在使用网格来实现这一点。只是想知道grob是什么意思,同时在内存中存储多个绘图可能会很昂贵,而且我希望在服务器重新启动时保持缓存。是否有包将绘图缓存到磁盘并从那里渲染它们?还想知道对于任何可以基于函数输入创建字符串散列的包,这对我来说很方便。
    grob
    只是一个
    图形对象
    。您可以像任何其他R对象一样将它们保存到磁盘。(请参见
    ?saveRDS
    )。但是,从磁盘加载它们可能只需要从头开始计算。请参阅
    ?renderImage
    上的示例,它可能会给您一些想法。我认为,基本上您需要一个返回PNG文件的记忆绘图函数,并使用renderImage调用该记忆函数。谢谢Joe。关于如何让我们的图像变得更亮的想法我们通过渲染来渲染自动缩放静态图像。
    output$plot <- renderCachedPlot(
      expr = {
        histfaithful(bins = input$bins, col = input$col) 
      },
      cache = diskCache()
    )
    
    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"))
    }
    
    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))
        )
      }
    )