如何让Shiny的downloadHandler等待所有标签页绘图渲染完成后再执行

Shiny的服务端与客户端通信为异步逻辑：updateTabsetPanel 属于服务端发往前端的指令，会等待当前服务端回调执行完毕后才会发送给前端，再执行标签切换、触发绘图渲染的操作。而原代码中downloadHandler里的rmarkdown::render是同步执行的，运行时所有标签切换指令还未生效，绘图也未开始渲染，因此plots列表仅包含此前已经渲染完成的内容。

该方案无需依赖标签切换触发绘图，将绘图逻辑抽为独立函数，生成报告时主动调用所有函数获取绘图对象即可，稳定性最高，无需修改原report.rmd文件。
修改后的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"))     
    )
  )
)

# 抽离绘图逻辑为独立函数，不受标签激活状态影响
generate_plot1 <- function() {
  ggplot(mtcars, aes(wt, mpg)) + geom_point()
}
generate_plot2 <- function() {
  ggplot(mtcars, aes(wt, cyl)) + geom_point()
}
generate_plot3 <- function() {
  ggplot(mtcars, aes(wt, disp)) + geom_point()
}

server <- function(input, output, session) {
  output$plot1 <- renderPlot({
    plot(generate_plot1())
  })  
  
  output$plot2 <- renderPlot({
    plot(generate_plot2())
  })  
  
  output$plot3 <- renderPlot({
    plot(generate_plot3())
  })  
  
  output$report <- downloadHandler(
    filename = ("report.html"),
    content = function(file) {
      # 直接调用函数生成所有绘图，无需切换标签
      plots <- list(generate_plot1(), generate_plot2(), generate_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)

该方案无论用户是否手动点开过所有标签，生成的报告都能正常包含全部三张绘图。

如果实际业务中绘图逻辑必须依赖标签激活才能运行（比如绘图参数由标签内的交互控件控制），可以将下载按钮替换为普通actionButton，增加渲染状态监听，等待所有绘图渲染完成后再触发下载：

library(shiny)
library(ggplot2)
library(shinyjs)

ui <- fluidPage(
  useShinyjs(),
  mainPanel(
    tabsetPanel(id = "tabs",
                tabPanel("Plot1",
                         actionButton("trigger_report", "create report"),
                         # 隐藏的下载按钮，等所有图渲染完后自动触发
                         downloadButton("report", style = "display:none;"),
                         plotOutput("plot1")
                ),
                tabPanel("Plot2", plotOutput("plot2")),
                tabPanel("Plot3", plotOutput("plot3"))     
    )
  )
)

server <- function(input, output, session) {
  plots <<- list()
  # 记录绘图渲染状态
  render_status <- reactiveVal(c(FALSE, FALSE, FALSE))
  
  output$plot1 <- renderPlot({
    plots[[1]] <<- ggplot(mtcars, aes(wt, mpg)) + geom_point()
    new_status <- render_status()
    new_status[1] <- TRUE
    render_status(new_status)
    plot(plots[[1]])
  })  
  
  output$plot2 <- renderPlot({
    plots[[2]] <<- ggplot(mtcars, aes(wt, cyl)) + geom_point()
    new_status <- render_status()
    new_status[2] <- TRUE
    render_status(new_status)
    plot(plots[[2]])
  })  
  
  output$plot3 <- renderPlot({
    plots[[3]] <<- ggplot(mtcars, aes(wt, disp)) + geom_point()
    new_status <- render_status()
    new_status[3] <- TRUE
    render_status(new_status)
    plot(plots[[3]])
  })  
  
  # 监听报告生成触发按钮
  observeEvent(input$trigger_report, {
    # 重置状态
    render_status(c(FALSE, FALSE, FALSE))
    plots <<- list()
    # 依次切换标签
    updateTabsetPanel(session, "tabs", selected = "Plot1")
    updateTabsetPanel(session, "tabs", selected = "Plot2")
    updateTabsetPanel(session, "tabs", selected = "Plot3")
  })
  
  # 监听所有绘图渲染完成状态
  observeEvent(render_status(), {
    if(all(render_status())) {
      # 所有图渲染完后自动触发下载
      runjs("$('#report').click();")
    }
  })
  
  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()))
      # 切回原标签
      updateTabsetPanel(session, "tabs", selected = "Plot1")
    }
  )  
}

shinyApp(ui, server)

内容的提问来源于stack exchange，提问作者Houndmux