Downloading two outputs in R shiny with one Button

Viewed 45

I need to download two files with a single click of a button (instead of two buttons). This is easy to do indepedently; however, I'm finding it near impossible for this with only one button. In the app example below, write.csv(mtcarss_3(), file = file) gets executed inside the downloadHandler; however, not the write.csv(mtcarss_4(), file = file) part. Is it possible to do this in Shiny? If so, how? Thanks for your help

library(shiny)
library(dplyr)
ui <- fluidPage(
  h3("mtcars df gear == 4"),
  h3("mtcars df gear == 3"),
  downloadButton("gears", "download both tables")
)

server <- function(input, output, session) {
  rv = reactiveVal("gears_3")
  
  mtcarss <- reactive(
    mtcars
  )
  
  mtcarss_3 <- reactive({
    req(mtcarss())
     
    mtcarss() %>% 
      filter(gear == 3) %>% 
      pull(mpg)
  })
  
  mtcarss_4 <- reactive({
    req(mtcarss())
    
    mtcarss() %>% 
      filter(gear == 4) %>% 
      pull(mpg)
  })
  
  output$gears <- downloadHandler(
    filename = function() {"gears_3.txt"},
    content = function(file) {
      write.csv(mtcarss_3(), file = file)
      write.csv(mtcarss_4(), file = file)
    }
    )
}

shinyApp(ui, server)
3 Answers

You can zip all files then download the zip file instead of trying to make multiple downloads at once:

library(shiny)
library(dplyr)
ui <- fluidPage(
  h3("mtcars df gear == 4"),
  h3("mtcars df gear == 3"),
  downloadButton("gears", "download both tables")
)

server <- function(input, output, session) {
  rv = reactiveVal("gears_3")

  mtcarss <- reactive(
    mtcars
  )

  mtcarss_3 <- reactive({
    req(mtcarss())

    mtcarss() %>%
      filter(gear == 3) %>%
      pull(mpg)
  })

  mtcarss_4 <- reactive({
    req(mtcarss())

    mtcarss() %>%
      filter(gear == 4) %>%
      pull(mpg)
  })

  output$gears <- downloadHandler(
    filename = 'files.zip',
    content = function(fname) {
      tmpdir <- tempdir()
      setwd(tempdir())

      fs <- c("file1.txt", "file2.txt")
      write.csv(mtcarss_3(), file = "file1.txt", sep =",")
      write.csv(mtcarss_4(), file = "file2.txt", sep =",")

      zip(zipfile=fname, files=fs)
    },
    contentType = "application/zip"
  )
}

shinyApp(ui, server)

As other mentioned, multiple files downloads are definitely not on the best practices of UX, but there are cases it might be needed.

With some JS magic you can do it:

#https://stackoverflow.com/questions/73790843/downloading-two-outputs-in-r-shiny-with-one-button
library(shiny)
library(dplyr)
ui <- fluidPage(
  h3("mtcars df gear == 4"),
  h3("mtcars df gear == 3"),
  downloadButton("gears", "download both tables", onclick = "document.getElementById('gears_4').click()"),
  downloadButton("gears_4", "download both tables",  style = "opacity: 0; position: fixed; pointer-events:none;")
)

server <- function(input, output, session) {
  rv = reactiveVal("gears_3")
  
  mtcarss <- reactive(mtcars)
  
  mtcarss_3 <- reactive({
    req(mtcarss())
    
    mtcarss() %>%
      filter(gear == 3) %>%
      pull(mpg)
  })
  
  mtcarss_4 <- reactive({
    req(mtcarss())
    
    mtcarss() %>%
      filter(gear == 4) %>%
      pull(mpg)
  })
  
  output$gears <- downloadHandler(
    filename = function() {"gears_3.txt"},
    content = function(file) {
      write.csv(mtcarss_3(), file = file)
    }
  )
  # Separate downloadHandler
  output$gears_4 <- downloadHandler(
    filename = function() {"gears_4.txt"},
    content = function(file) {
      write.csv(mtcarss_4(), file = file)
    }
  )
}

shinyApp(ui, server)

The idea is simple: have separated download buttons, hide the extra button but trigger it with Javascript.

Tested and worked with Chrome Version 105.0.5195.127 (Official Build) (64-bit). Although it did asked for confirmation.

I changed the downloadButton to an actionButton and I am using a numericInput to choose how many files to download. You can easily change this to a selectInput/textInput/pickerInput using file names and change the loop that is downloading the files.

the actionButton leads to a loop where the downloadButtons are clicked using shinyjs package's click function. Re. the downloadButtons you could code them into your apps UI as before but put them all inside one hidden div, but instead, here I dynamically generated them based on how many files the user wants from the server. This is not necessary at all. You could just as well have hard coded them. The reason I used the insertUI and removeUI was due to a different solution I started with but ended instead with shinyjs which was much simpler.

When you click on the actionButton the number of files you wanted will download.

library(shiny)
library(shinyjs)
library(dplyr)

ui <- fluidPage(
  shinyjs::useShinyjs(),
  h3("mtcars df gear == 4"),
  h3("mtcars df gear == 3"),
  numericInput("num_files", "Number of tables", value = 3, min = 1, max = 3),
  actionButton("gears_dloads", "download tables"),
)

server <- function(input, output, session) {
  rv = reactiveVal("gears_3")
  
  # Observe that dynamically generates and removes UI based on the numericInput
  observe({
    if(is.na(input$num_files) || input$num_files <= 0 || input$num_files > 3){
      removeUI(
        selector = (".hidden-div"), #remove all the divs with class hidden-div
        multiple = TRUE,
        immediate = TRUE
      )
    }
    else if(input$num_files >0 &&input$num_files <= 3){
      for (i in 1:input$num_files)){
        # keep inserting hidden UIs
        insertUI(
          selector = paste0("#gears_dloads"), # select the id gears_download relative to where the new UI elements will go
          where = "afterEnd",
          ui = div(downloadButton(paste0("gears_dload_",i),""), style = "visibility:hidden;",class="hidden-div")
        )
      }
    }
  })
  
  observeEvent(input$gears_dloads, {
    req(input$num_files)
    if(input$num_files > 0 && input$num_files <=3){
      for (i in 1:input$num_files) {
        shinyjs::click(paste0("gears_dload_",i))
      }
    }
  })
  
  mtcarss <- reactive(
    mtcars
  )
  
  
  mtcarss_3 <- reactive({
    req(mtcarss())
    
    mtcarss() %>% 
      filter(gear == 3) %>% 
      pull(mpg)
  })
  
  mtcarss_4 <- reactive({
    req(mtcarss())
    
    mtcarss() %>% 
      filter(gear == 4) %>% 
      pull(mpg)
  })
  
  output$gears_dload_1 <- downloadHandler(
    filename = function() {"gears.txt"},
    content = function(file) {
      write.csv(mtcarss(), file = file)
    }
  )
  
  output$gears_dload_2 <- downloadHandler(
    filename = function() {"gears_3.txt"},
    content = function(file) {
      write.csv(mtcarss_3(), file = file)
    }
  )
  
  output$gears_dload_3 <- downloadHandler(
    filename = function() {"gears_4.txt"},
    content = function(file) {
      write.csv(mtcarss_4(), file = file)
    }
  )
}

shinyApp(ui, server)

Related