Shiny - export multiple figures dynamically created through renderUI - r

Question

I have an app that is creating a dynamic number of images, based on various user inputs. The plotting is being done using renderUI following this link, but with modifications required for my own setup. I now need to export these plots, but can't figure out how to make that happen. I know how to export an individual plot (which is included in the example below), but am looking to modify the code below to be able to export a dynamic number of models.
Would appreciate any suggestions!
library(shiny)
library(dplyr)
library(ggplot2)
# fake data
df <- data.frame(x = 1:10, y = letters[1:10]) %>%
mutate(Plot = x %/% 3.1 + 1)
# function for plotting dynamic number of plots
get_plot_output_list <- function(input_n, df) {
# Insert plot output objects the list
plot_output_list <- lapply(1:input_n, function(i) {
sub <- df %>% filter(Plot == i)
plotname <- paste("plot", i, sep="")
plot_output_object <- plotOutput(plotname, height = 280, width = 250)
plot_output_object <- renderPlot({
ggplot(sub) + geom_point(aes(x = x, y = y))
})
})
do.call(tagList, plot_output_list) # needed to display properly.
}
ui <- navbarPage("My app", id = "nav",
tabPanel("Single plot",
fluidRow(column(9, plotOutput("plot1")),
column(2, downloadButton('ExportPlot1', label = "Download plot1")))),
tabPanel("Multiple plots",
fluidRow(column(9,
selectInput("NPlots", label = "Select number of plots to make", choices = 1:3, selected = 1),
uiOutput("plots")),
column(2, downloadButton('ExportPlots', label = "Download all dynamic plots")))))
server <- (function(input, output) {
observe({
output$plots <- renderUI({ get_plot_output_list(input$NPlots, df) })
})
plot.calc <- reactive({
p <- ggplot(df) + geom_point(aes(x = x, y = y))
output <- list(p = p)
})
output$plot1 <- renderPlot({ plot.calc()$p })
output$ExportPlot1 <- downloadHandler(
filename = 'Plot1.html',
content = function(file) {
src <- normalizePath(c('Plot1.Rmd')) # SEE HERE
owd <- setwd(tempdir())
on.exit(setwd(owd))
file.copy(src, c('Plot1.Rmd'), overwrite = TRUE) # SEE HERE
params <- list(Plot1 = plot.calc()$p)
Sys.setenv(RSTUDIO_PANDOC="C:/Program Files/RStudio/bin/pandoc")
out <- rmarkdown::render('Plot1.Rmd', output_file = file, params = params, envir = new.env(parent = globalenv()))
file.rename(out, file)
})
})
shinyApp(ui, server)
Rmd file:
---
title: "Untitled"
author: "test"
date: "24 3 2021"
output: html_document
params:
Plot1: NA
---
My plot
```{r, echo = FALSE, warning = FALSE, fig.width = 6.4, fig.height = 3.5}
params$Plot1
```

Answer 1

When you separate the plot generation and the actual plotting, you can pass the generated plots to the Rmd. BTW you don't need observe when you work with reactives like input$NPlots:
library(shiny)
library(dplyr)
library(ggplot2)
# fake data
df <- data.frame(x = 1:10, y = letters[1:10]) %>%
mutate(Plot = x %/% 3.1 + 1)
generate_plots <- function(input_n, df) {
plot_output_list <- lapply(1:input_n, function(i) {
sub <- df %>% filter(Plot == i)
p <- ggplot(sub) + geom_point(aes(x = x, y = y))
p
})
plot_output_list
}
ui <- navbarPage("My app", id = "nav",
tabPanel("Single plot",
fluidRow(column(9, plotOutput("plot1")),
column(2, downloadButton('ExportPlot1', label = "Download plot1")))),
tabPanel("Multiple plots",
fluidRow(column(9,
selectInput("NPlots", label = "Select number of plots to make", choices = 1:3, selected = 1),
uiOutput("plots")),
column(2, downloadButton('ExportPlots', label = "Download all dynamic plots")))))
server <- (function(input, output) {
plot_data <- reactive({
generate_plots(input$NPlots, df)
})
output$plots <- renderUI({
plot_output_list <- lapply(seq_len(length(plot_data())), function(i) {
plotname <- paste("plot", i, sep="")
plot_output_object <- plotOutput(plotname, height = 280, width = 250)
plot_output_object <- renderPlot({
plot_data()[[i]]
})
})
do.call(tagList, plot_output_list) # needed to display properly.
})
plot.calc <- reactive({
p <- ggplot(df) + geom_point(aes(x = x, y = y))
output <- list(p = p)
})
output$plot1 <- renderPlot({ plot.calc()$p })
output$ExportPlot1 <- downloadHandler(
filename = 'Plot1.html',
content = function(file) {
src <- normalizePath(c('Plot1.Rmd')) # SEE HERE
owd <- setwd(tempdir())
on.exit(setwd(owd))
file.copy(src, c('Plot1.Rmd'), overwrite = TRUE) # SEE HERE
params <- list(Plot1 = plot.calc()$p,
Plot_list = plot_data())
Sys.setenv(RSTUDIO_PANDOC="C:/Program Files/RStudio/bin/pandoc")
out <- rmarkdown::render('Plot1.Rmd', output_file = file, params = params, envir = new.env(parent = globalenv()))
file.rename(out, file)
})
output$ExportPlots <- downloadHandler(
filename = 'Plots.html',
content = function(file) {
src <- normalizePath(c('Plots.Rmd')) # SEE HERE
owd <- setwd(tempdir())
on.exit(setwd(owd))
file.copy(src, c('Plots.Rmd'), overwrite = TRUE) # SEE HERE
params <- list(Plot_list = plot_data())
Sys.setenv(RSTUDIO_PANDOC="C:/Program Files/RStudio/bin/pandoc")
out <- rmarkdown::render('Plots.Rmd', output_file = file, params = params, envir = new.env(parent = globalenv()))
file.rename(out, file)
})
})
shinyApp(ui, server)
Plots.Rmd
---
title: "Untitled"
author: "test"
date: "24 3 2021"
output: html_document
params:
Plot_list: NA
---
Multiple Plots
```{r, echo = FALSE, warning = FALSE, fig.width = 6.4, fig.height = 3.5}
purrr::walk(params$Plot_list, print)
```