时间戳

首页 > 解决方案 > 延迟 downloadHandler 直到生成图

r - 延迟 downloadHandler 直到生成图

问题描述

我想使用 Shiny 应用程序中各个选项卡中的图表生成 R Markdown 报告。
只有在用户激活选项卡后，才会生成每个选项卡中的图。如果之前未激活选项卡，则该图将不存在，因此无法用于报告。
因此，我尝试在调用 downloadHandler 之前使用 updateTabsetPanel 连续打开所有选项卡。然而，与手动单击选项卡相反，空选项卡会打开，并且文件下载对话框会在绘图开始渲染之前立即出现。只有在保存报告文件后，Shiny 才会开始渲染绘图并且报告是空的。
有没有办法强制 downloadHandler 等到所有选项卡中的所有绘图完成渲染？

这是一个例子：

应用程序.R

library(shiny)
library(ggplot2)

ui <- fluidPage(
  mainPanel(
    tabsetPanel(id = "tabs",
                tabPanel("Plot1",
                         downloadButton("report", "create report"),
                         plotOutput("plot1")
                ),
                tabPanel("Plot2", plotOutput("plot2")),
                tabPanel("Plot3", plotOutput("plot3"))     
    )
  )
)
server <- function(input, output, session) {
  plots <<- list()
  
  output$plot1 <- renderPlot({
    plots[[1]] <<- ggplot(mtcars, aes(wt, mpg)) + geom_point()
    plot(plots[[1]])
  })  
  
  output$plot2 <- renderPlot({
    plots[[2]] <<- ggplot(mtcars, aes(wt, cyl)) + geom_point()
    plot(plots[[2]])
  })  
  
  output$plot3 <- renderPlot({
    plots[[3]] <<- ggplot(mtcars, aes(wt, disp)) + geom_point()
    plot(plots[[3]])
  })  
  
  
  output$report <- downloadHandler(
    filename = ("report.html"),
    content = function(file) {
      updateTabsetPanel(session, "tabs", selected = "Plot1")
      updateTabsetPanel(session, "tabs", selected = "Plot2")
      updateTabsetPanel(session, "tabs", selected = "Plot3")
      tempReport <- file.path(tempdir(), "report.rmd")
      file.copy("report.rmd", tempReport, overwrite = TRUE)
      params <- list(plots = plots)
      rmarkdown::render(tempReport, output_file = file, params = params, envir = new.env(parent = globalenv()))
    }
  )  
}

shinyApp(ui, server)

报告.rmd

---
title: "report"
output: html_document
params:
  plots: NA
---

```{r}
  for (i in params$plots)
    plot(i)
```

在这种情况下，为了简单起见，我将 tabPanel 调用放在 downloadHandler 中。他们应该打开所有选项卡，以便渲染绘图，然后，rmarkdown 可以绘制它们。
如果单击“报告”按钮，将打开第 3 个选项卡，并且在呈现选项卡 2 和 3 的图之前出现文件对话框，因此报告仅包含图 1。但是如果您手动单击所有 3 个选项卡，然后单击“报告”，所有绘图都将被渲染并包含在报告中。

标签： rshiny

解决方案

尝试：

  output$plot1 <- renderPlot({
    plots[[1]] <<- ggplot(mtcars, aes(wt, mpg)) + geom_point()
    plot(plots[[1]])
  })  
  outputOptions(output, "plot1", suspendWhenHidden = FALSE)

  output$plot2 <- renderPlot({
    plots[[2]] <<- ggplot(mtcars, aes(wt, cyl)) + geom_point()
    plot(plots[[2]])
  })  
  outputOptions(output, "plot2", suspendWhenHidden = FALSE)
  
  output$plot3 <- renderPlot({
    plots[[3]] <<- ggplot(mtcars, aes(wt, disp)) + geom_point()
    plot(plots[[3]])
  })  
  outputOptions(output, "plot3", suspendWhenHidden = FALSE)

编辑

以上不起作用。以下作品。

library(shiny)
library(ggplot2)

ui <- fluidPage(
  mainPanel(
    tabsetPanel(id = "tabs",
                tabPanel("Plot1",
                         downloadButton("report", "create report"),
                         plotOutput("plot1")
                ),
                tabPanel("Plot2", plotOutput("plot2")),
                tabPanel("Plot3", plotOutput("plot3"))     
    )
  )
)
server <- function(input, output, session) {
  plots <- vector("list", length = 3L)
  
  plots[[1L]] <- reactive({
    ggplot(mtcars, aes(wt, mpg)) + geom_point()
  })
  plots[[2L]] <- reactive({
    ggplot(mtcars, aes(wt, cyl)) + geom_point()
  })
  plots[[3L]] <- reactive({
    ggplot(mtcars, aes(wt, disp)) + geom_point()
  })
  
  
  output$plot1 <- renderPlot({
    plots[[1L]]()
  })  
  
  output$plot2 <- renderPlot({
    plots[[2L]]()
  })  
  
  output$plot3 <- renderPlot({
    plots[[3L]]() 
  })  
  
  
  output$report <- downloadHandler(
    filename = "report.html",
    content = function(file) {
      tempReport <- file.path(tempdir(), "report.rmd")
      file.copy("report.rmd", tempReport, overwrite = TRUE)
      params <- list(plots = plots)
      rmarkdown::render(
        tempReport, output_file = file, params = params, 
        envir = new.env(parent = globalenv())
      )
    }
  )  
}

shinyApp(ui, server)

报告.Rmd：

---
title: "report"
output: html_document
params:
  plots: NA
---

```{r}
for(plot in params$plots)
  print(plot())
```

推荐阅读