R Shiny allow user to select one or multiple datasets to download

Question

I am new to R shiny and I hope someone can please guide me in the right direction.

I want the user to be able to select one or multiple datasets to download.

Code works when I put the multiple=F in selectInput but when I change it to TRUE, I get the error below:

"Warning: Error in switch: EXPR must be a length 1 vector"

Any help will be greatly appreciated as I am stuck on this for days.

Thank you

library(shiny)
library(openxlsx)

# Define UI for data download app ----
ui <- fluidPage(
  
  # App title ----
  titlePanel("Downloading Data"),
  
  # Sidebar layout with input and output definitions ----
  sidebarLayout(
    
    # Sidebar panel for inputs ----
    sidebarPanel(
      
      # Input: Choose dataset ----
      selectInput("dataset", "Choose a dataset:",
                  choices = c("rock", "pressure", "cars"), multiple=T),
      
      # Button
      downloadButton("downloadData", "Download")
      
    ),
    
    # Main panel for displaying outputs ----
    mainPanel(
      
      tableOutput("table")
      
    )
    
  )
)

# Define server logic to display and download selected file ----
server <- function(input, output) {
  
  # Reactive value for selected dataset ----
  datasetInput <- reactive({
    switch(input$dataset,
           "rock" = rock,
           "pressure" = pressure,
           "cars" = cars)
  })
  
  # Table of selected dataset ----
  output$table <- renderTable({
    datasetInput()
  })
  
  # Downloadable xlsx of selected dataset ----
  output$downloadData <- downloadHandler(
    filename = function() {
      "selected.xlsx"
    },
    content = function(filename) {
      write.xlsx(datasetInput(), file = filename, rowNames = FALSE)
    }
  )
  
}

# Create Shiny app ----
shinyApp(ui, server)

Answer 1

In order to display several datasets, you can create a module (it is like creating a smaller shiny app inside your shiny app that you can call with parameters, just like a function). Here I created a module to display a table, with a dataframe as parameter. For the download, I followed the link I gave you previously.

library(shiny)


#Using module
mod_export_table_ui <- function(id){
  ns <- NS(id)
  tagList(
      tableOutput(ns("table_export"))
  )
}

mod_export_table_server <- function(input, output, session, df_export){
  ns <- session$ns
  output$table_export <- renderTable({
    df_export
  })
}


# Define UI for data download app ----
ui <- fluidPage(
  
  # App title ----
  titlePanel("Downloading Data"),
  
  # Sidebar layout with input and output definitions ----
  sidebarLayout(
    
    # Sidebar panel for inputs ----
    sidebarPanel(
      
      # Input: Choose dataset ----
      selectInput("dataset", "Choose a dataset:",
                  choices = c("rock", "pressure", "cars"), multiple=T),
      
      # Button
      downloadButton("downloadData", "Download")
      
    ),
    
    # Main panel for displaying outputs ----
    mainPanel(
      uiOutput("tables")
    )
  )
)

# Define server logic to display and download selected file ----
server <- function(input, output, session) {

  rv <- reactiveValues()
  
  #List of datasets
  observeEvent(input$dataset, {
    req(input$dataset)
    rv$lst_datasets <- lapply(
          1:length(input$dataset),
          function(i) {
            head(eval(parse(text =input$dataset[i])))
          }
        )
  })
  
  # Module UIs 
  output$tables <- renderUI({
    req(rv$lst_datasets)
    lapply(
      1:length(rv$lst_datasets),
      function(i) {
        mod_export_table_ui(id = paste0("table", i))
      }
    )
  })
  
  # Module Servers
  observeEvent(rv$lst_datasets, {
    req(rv$lst_datasets)
    lapply(
      1:length(rv$lst_datasets),
      function(i) {
        callModule(
          module = mod_export_table_server,
          session = session,
          id = paste0("table", i),
          df_export = rv$lst_datasets[[i]]
        )
      }
    )
  })
  
  output$downloadData <-downloadHandler(
    filename = "Downloads.zip",
    content = function(file){
      withProgress(message = "Writing Files to Disk. Please wait...", {
        temp <- setwd(tempdir())
        on.exit(setwd(temp))
        files <- c()
        
        for(i in 1:length(rv$lst_datasets)){
          writexl::write_xlsx(rv$lst_datasets[[i]],
                              path = paste0("dataset",i, ".xlsx")
          )
          
          files <- c(files, paste0("dataset",i, ".xlsx"))
        }
        zip(zipfile = file, files = files)
      })
    }
  )
  
}

# Create Shiny app ----
shinyApp(ui, server)