Home > Enterprise >  Delay downloadHandler until plots are generated
Delay downloadHandler until plots are generated

Time:10-05

I want to generate a R Markdown report using plots from various tabs in my Shiny app.
The plots in each tab get generated only once the tab is activated by the user. If a tab was not activated before, the plot will not exist and thus will not be available for the report.
Therefore I tried to successively open all tabs using updateTabsetPanel before calling downloadHandler. However as opposed to manually clicking the tabs, the empty tabs open and the file download dialog appears immediately before the plots start to render. Only after saving the report file, Shiny will start to render the plots and the report is empty.
Is there a way to force the downloadHandler to wait until all plots in all tabs finished rendering?

Here's an example:

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}
  for (i in params$plots)
    plot(i)
```

In this case, I put the tabPanel calls in the downloadHandler for simplicity. They are supposed to open all tabs so the plots get rendered and after that, rmarkdown can plot them.
If you click the "report" button, the 3rd tab will open and the file dialog appears before the plots from tabs 2 and 3 are rendered, so the report only contains plot 1. But if you manually click all 3 tabs and then click "report", all plots will be rendered and included in the report.

CodePudding user response:

Try:

  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)

EDIT

The above does not work. The following works.

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}
for(plot in params$plots)
  print(plot())
```
  • Related