How to download graphs which are dynamic in R Shiny?

Question

In Shiny Dashboard in a Tab I am plotting graphs one below the another, based on the selection of checkbox inputs. When the check boxes are selected accordingly the graphs will get displayed one below the another. Kindly find the code below which i used.

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(dplyr)
d <-
  data.frame(
    year = c(1995, 1995, 1995, 1996, 1996, 1996, 1997, 1997, 1997),
    Product_Name = c(
      "Table",
      "Chair",
      "Bed",
      "Table",
      "Chair",
      "Bed",
      "Table",
      "Chair",
      "Bed"
    ),
    Product_desc = c("X", "X", "X", "Y", "Y", "Y", "Z", "Z", "Z"),
    Cost = c(1, 2, 3, 4, 2, 3, 4, 5, 6)
  )

ui <- shinyUI(fluidPage(
  useShinydashboard(),
  tabPanel(
    "Plot",
    sidebarLayout(
      sidebarPanel(
        radioButtons(
          "Choose",
          "Choose One",
          c("Year" = "p", "Numbers" = "l")
        ),
        uiOutput('checkbox'),
        #width = 2,
        position = "bottom"),
      mainPanel(uiOutput("graph"),
                uiOutput("graph_1"))
      
    )
  )
))

server <- function(input, output, session) {
  
  z_1 <- reactiveValues(years = NULL)
  z_2 <- reactiveValues(numbers = NULL)
  
  observeEvent(input$X, {
    z_1$years <- input$X
  })
  
  observeEvent(input$X_1, {
    z_2$numbers <- input$X_1
  })
  
  output$checkbox <- renderUI({
    if (input$Choose == "p") {
      checkboxGroupInput("X",
                         "year",
                         choices = (unique(d$year)),selected = z_1$years)
      
    } else{
      checkboxGroupInput("X_1",
                         "Numbers",
                         choices = c("1","2","3","4"), ,selected = z_2$numbers)
    }
    
  })
  
  output$graph <- renderUI({
    ntabs = length(input$X)
    if(input$Choose == "p"){
    myTabs = lapply(seq_len(ntabs), function(i) {
      
      fluidRow(plotOutput(paste0("plot", i)))
    })
    }else return(NULL)
  })
  
  
  output$graph_1 <- renderUI({
    ntabs = length(input$X_1)
    if(input$Choose == "l"){
    myTabs = lapply(seq_len(ntabs), function(i) {
      
      fluidRow(plotOutput(paste0("plot_1", i)))
    })
    }else return(NULL)
  })
  
  
  observe (lapply(length(input$X), function(i) {
    output[[paste0("plot", i)]] <- renderPlot({
      if (length(input$X) > 0) {
        d %>%
          ggplot(aes(Product_Name, Cost)) +
          geom_col(aes(fill = Product_desc),
                   position = position_dodge(preserve = "single")) +
          facet_wrap( ~ input$X[i],
                      scales = "free_x",
                      strip.position = "bottom") +
          theme(strip.placement = "outside") +
          theme_bw()
      }
    })
    
  }))
  
  
  observe (lapply(length(input$X_1), function(i) {
    output[[paste0("plot_1", i)]] <- renderPlot({
      if (length(input$X_1) > 0) {
        d %>%
          ggplot(aes(Product_Name, Cost)) +
          theme(strip.placement = "outside") +
          theme_bw()
      }
    })
    
  }))
  
}

shinyApp(ui, server)

What I am trying to do now is I "Wanted to download these plots" which are getting dynamically generated based on the user check box input. If the user had generated 1 graph I wanted to download it. If the user had generated 3 graphs then i want to download all the generated graphs in one single jpeg file.

I tried using downloadHandler, but unfortunately i was very very unsuccessful in it.

The issue which I am facing in this case is as the graphs are dynamic in Nature I am not able to store or write a code in the downloadHandler. The dynamic Nature of the Graph is making it difficult.

Can someone please suggest me how to overcome this.

thothal · Accepted Answer

Shiny Modules [*] would be a neat possibility here.

Note. I did not fully understand what you tried with your dynamic checkboxGroup, so I replaced it by a static one. Also I was not quite clear what you want to plot in particular. This is however anyways not crucial to the problem at hand, which can be described as follows

Download a dynamic amount of figures in one file.

So here we go, explanation below.

Setup

library(shiny)
library(dplyr)
library(gridExtra)

d <- data.frame(
   year         = c(1995, 1995, 1995, 1996, 1996, 1996, 1997, 1997, 1997),
   Product_Name = c("Table", "Chair", "Bed", "Table", "Chair", "Bed", "Table",
                    "Chair", "Bed"),
   Product_desc = rep(LETTERS[24:26], each = 3),
   Cost         = c(1, 2, 3, 4, 2, 3, 4, 5, 6)
)

Shiny Modules

plot_ui <- function(id) {
   ns <- NS(id)
   plotOutput(ns("graph"))
}

plot_server <- function(input, output, session, my_data, graph_type) {
   
   get_graph <- reactive({
      base_plot <- ggplot(my_data,
                          aes(Product_Name, Cost)) +
         theme(strip.placement = "outside") +
         theme_bw()
      if (graph_type() == "b") {
         res <- base_plot +
            geom_col(aes(fill = Product_desc),
                     position = position_dodge(preserve = "single")) +
            facet_wrap(~year)
      } else if (graph_type() == "p") {
         res <- base_plot +
            geom_point()
      }
      res
   })
   
   output$graph <- renderPlot({
      get_graph()
   })
   
   list(graph = get_graph)
}

Main App

ui <- fluidPage(
   titlePanel("Modules to the Rescue!"),
   sidebarLayout(
      sidebarPanel(
         radioButtons(
            "type",
            "Graph Type",
            c(Bars = "b", Points = "p")
         ),
         checkboxGroupInput("selector",
                            "Year",
                            choices = unique(d$year)),
         downloadButton("download", "Download Graphs")
         ),
      mainPanel(div(id = "container", div("test content")))
   )
)

server <- function(input, output, session) {

   ## store active plot handlers
   all_plots <- reactiveVal()
   
   ## counter to ensure unique ids for the module uis
   cnt <- reactiveVal(0)
   
   ## when we change selector draw plots anew
   observe({
      ## remove all existing plots
      removeUI("#container *", immediate = TRUE, multiple = TRUE)
      ## for each selection create a new plot
      ## SIDE EFFECT: create the UI
      handlers <- lapply(input$selector, function(x) {
         cnt(isolate(cnt()) + 1)
         my_dat <- d %>%
            dplyr::filter(year == x)
         new_id <- paste("plot", isolate(cnt()))
         insertUI("#container", ui = plot_ui(new_id))
         callModule(plot_server, new_id, 
                    my_data = my_dat, 
                    graph_type = reactive(input$type))
      })
      all_plots(handlers)
   })
   
   output$download <- downloadHandler(
      filename = function() {
         paste0("plots-", Sys.Date(), ".png")
      }, content = function(file) {
         my_plots <- all_plots()
         ggsave(file,
                plot = marrangeGrob(lapply(my_plots, function(handle) handle$graph()),
                                    ncol = 1, nrow = length(my_plots)))
      }
   )
}

shinyApp(ui, server)

Explanation

(The linked document describes in depth what modules are doing so I focus on I used them, rather on how they work in general.)

We create a module whihc does the plotting for us.
The module creates a reactive which produces the plot.
This reactive is used twice: once in the renderPlot function to render the plot, and once as a return parameter of the module.
In the main app, we keep track about all created modules (all_plots), through which we can communicate with the model and in particular to retrieve the plot.
To draw the plots, we listen to the checkboxGroup and whenever there is a change we dynamically remove all plots, and add them afresh and update all_plots through which we can in the last step retrieve the plots for the downloadHandler.
In the downloadHandler we loop through all plots and use gridExtra::marrange to put all of the ggplots into one file via ggsave.

[*] Note that I still use the old callModule syntax as I have noi yet upgraded shiny.

How to download graphs which are dynamic in R Shiny?

Answers (2)

Related Questions