R Shiny允许用户选择一个或多个数据集进行下载

Question

我是R shine的新手，希望有人能引导我朝着正确的方向前进。

我希望用户能够选择一个或多个数据集进行下载。

当我在selectInput中输入倍数=F时，代码有效，但当我将其更改为TRUE时，我会得到以下错误：

"警告：开关错误：EXPR必须是长度为1的矢量"；

任何帮助都将不胜感激，因为我已经在这件事上呆了好几天了。

谢谢

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

为了显示多个数据集，您可以创建一个模块(这就像在闪亮的应用程序中创建一个较小的闪亮应用程序，您可以使用参数调用它，就像函数一样(。在这里，我创建了一个模块来显示一个表，并将数据帧作为参数。对于下载，我遵循了之前给你的链接。

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)