кэширование графиков в R / Shiny

просто интересно, есть ли трюки/способы, которыми я мог бы кэшировать сюжеты, генерируемые через наше блестящее приложение.

Справочная информация:

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

Подробнее:

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

спасибо! - Абхи!--1-->

8
r shiny shiny-server

3 ответов

если вы используете ggplot (что с блестящим, я бы поспорил, является справедливым предположением).

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

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

для кэширования я использовал digest::digest() где я только что ввел список параметров для этого конкретного графика в эту функцию для создания хэш-строки. Сначала я думал, что мне придется извлечь хэш-строку из observe() а затем используйте if / else statment, чтобы определить, должен ли я отправить его в 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')
    )
  )
)

и сервер.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)
}
2

хотя оба ответа на этот вопрос очень хороший, я хотел добавить еще один, используя блестящие модули. Следующий модуль принимает функцию 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(tempdir(), pattern = prefix, full.names = TRUE)
    file.remove(imgfiles)
  })
}

cachePlotUI <- function(id){
  ns <- NS(id)
  imageOutput(ns("plot"))
}

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

для примера использования, я использую 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))
    )
  }
)
2