延迟downloadHandler直到生成图

Question

我想要生成一个report报告使用从不同的选项卡在我的闪亮应用程序的情节。

每个选项卡中的地块只有在用户激活该选项卡后才会生成。如果以前没有激活选项卡，则小区将不存在，因此无法用于报表。

因此，在调用updateTabsetPanel之前，我尝试使用downloadHandler依次打开所有选项卡。但是，与手动单击选项卡相反，空选项卡将打开，文件下载对话框将在绘图单元开始呈现之前立即出现。只有在保存了报表文件后，才会开始呈现图表，并且报表是空的。

有没有办法强迫downloadHandler等待直到所有选项卡中的所有绘图完成呈现？

下面是一个例子：

app.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)

report.rmd

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

```{r}

为(我在市政厅)

plot(i)

在本例中，为了简单起见，我将tabPanel调用放在downloadHandler中。他们应该打开所有的制表符，这样情节就会呈现出来，然后，重标记就可以画出来了。

如果单击“报告”按钮，将打开第三个选项卡，并在呈现表2和表3的绘图之前显示文件对话框，因此报表只包含图1。但是，如果手动单击所有3个选项卡，然后单击“报告”，则所有绘图都将呈现并包含在报表中。

Answer 1

尝试：

  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)

report.Rmd:

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

```{r}

用于(平面图中的地块)

打印(图())