我在Internet上四处寻找并尝试了多种解决方案，但似乎都没有用。 简而言之，这就是我的问题：我创建了一个闪亮的应用程序，用户可以在其中上传csv文件并将其保存在数据集中。现在，我想将每个上传的数据集保存在一个列表中，这将通过selectInput按钮帮助我选择要查看的数据集，这是我到目前为止编写的代码：
server <- function(input, output) {
datasetlist <- list()
output$contents <- renderTable({
# input$file1 will be NULL initially. After the user selects
# and uploads a file, head of that data file by default,
# or all rows if selected, will be shown.
req(input$file1)
input$update
tryCatch({
df <- read.csv(
input$file1$datapath,
header = isolate(input$header),
sep = isolate(input$sep),
dec = isolate(input$dec),
quote = isolate(input$quote)
)
},
error = function(e) {
# return a safeError if a parsing error occurs
stop(safeError(e))
})
# when reading semicolon separated files,
# having a comma separator causes `read.csv` to error
if (isolate(input$disp == "head")) {
return(head(df))
}
else {
return(df)
}
})
output$manage <- renderUI({
selectInput("dataset", "Dataset", choices = datasetlist[], selected = datasetlist[1])
})
}
加分点：如果有人也指出如何从列表中删除记录而不影响整个列表，我会很高兴
编辑1：在我早先收到的答案之后，这里是完整的代码，问题是我似乎找不到找到显示数据集表的方法
#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
library(shinydashboard)
library(shinythemes)
library(shinyFiles)
options(shiny.maxRequestSize = 30 * 1024 ^ 2)
# Define UI for application
ui <- fluidPage(#theme= shinytheme("paper"),
# Application title
navbarPage(
"Title",
# Sidebar with input
tabPanel("Data Manager",
sidebarLayout(
sidebarPanel(
uiOutput("manage"),
fileInput(
"file1",
"Choose CSV File",
multiple = FALSE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")
),
# Horizontal line ----
tags$hr(),
fluidRow(
# Input: Checkbox if file has header ----
column(4 ,checkboxInput("header", "Header", TRUE)),
# Input: Select number of rows to display ----
column(8, radioButtons(
"disp",
"Display",
choices = c(Head = "head",
All = "all"),
selected = "head",
inline = TRUE
))),
fluidRow(# Input: Select separator ----
column(
4, selectInput(
"sep",
"Separator",
choices = c(
Comma = ",",
Semicolon = ";",
Tab = "\t"
),
selected = ";"
)
),
# Input: Select decimals ----
column(
4 , selectInput(
"dec",
"Decimal",
choices = c("Comma" = ",",
"Period" = '.'),
selected = ','
)
)),
# Input: Select quotes ----
fluidRow(column(8 , selectInput(
"quote",
"Quote",
choices = c(
None = "",
"Double Quote" = '"',
"Single Quote" = "'"
),
selected = '"'
))),
# Horizontal line ----
tags$hr(),
actionButton("update", "Update")
),
mainPanel(fluidRow(tableOutput("contents")))
))
))
# Define server logic
server <- function(input, output, session) {
rv <- reactiveValues(
datasetlist = list()
)
observe({
# input$file1 will be NULL initially. After the user selects
# and uploads a file, head of that data file by default,
# or all rows if selected, will be shown.
req(input$file1)
input$update
tryCatch({
df <- read.csv(
input$file1$datapath,
header = isolate(input$header),
sep = isolate(input$sep),
dec = isolate(input$dec),
quote = isolate(input$quote)
)
},
error = function(e) {
# return a safeError if a parsing error occurs
stop(safeError(e))
})
# when reading semicolon separated files,
# having a comma separator causes `read.csv` to error
isolate(
rv$datasetlist <- c(rv$datasetlist,list(df))
)
})
observe({
updateSelectInput(
session = session,
inputId = "selected_dataset",
choices = 1:length(rv$datasetlist),
selected = input$selected_dataset
)
})
output$contents <- renderTable({
req(length(rv$datasetlist) >= input$selected_dataset)
df <- rv$datasetlist[[input$selected_dataset]]
if (isolate(input$disp == "head")) {
return(head(df))
}
else {
return(df)
}
})
output$manage <- renderUI({
tagList(
selectInput("selected_dataset", "Dataset", choices = '', selected = 1)
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
答案 0 :(得分：1)
使用file.copy()按用户将上传的文件复制到文件夹Selected_Files，然后使用eventReactive()将文件夹中的所有文件读取到列表中，即数据集列表。将数据集列表的元素命名为文件名。您可以使用datasetlist()在renderUI / renderTable中使用此列表反应性上下文。
我在下面编写了可能会解决您问题的代码。另外，read.csv具有sep参数，该参数处理不同的分隔符。我使用radioButtons为用户提供文件分隔符。
编辑：为了正确捕获所有已上传文件的文件格式，我创建了一个列表df，用于捕获用户输入的文件格式并将其另存为R Object File_Format。 rds 在工作目录中。然后使用readRDS将保存的列表作为old_df加载并将其附加到当前的df。
Edit2 ：我认为，当使用不同的参数上传同一文件时，列表File_Format的名称保持相同，因此选择了重复项的第一个元素。我通过将上传次数作为名称的索引添加前缀来解决此问题。此外，在代码的开头，我添加了两个语句来删除RDS文件和文件夹Selected_Files中的所有文件。因此，无论何时打开应用程序，这些文件都会先被删除，然后再进行交互式会话。
更新的代码在
下方library(shiny)
if (file.exists("File_Format.rds")) file.remove("File_Format.rds")
do.call(file.remove, list(list.files("Selected_Files", full.names = TRUE)))
ui <- fluidPage(
# tableOutput("contents"),
sidebarPanel(
fileInput("file1", "Choose CSV File",
multiple = FALSE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
# Horizontal line ----
tags$hr(),
# Input: Checkbox if file has header ----
checkboxInput("header", "Header", TRUE),
# Input: Select separator ----
radioButtons("sep", "Separator",
choices = c(Comma = ",",
Semicolon = ";",
Tab = "\t"),
selected = ","),
# Input: Select quotes ----
radioButtons("quote", "Quote",
choices = c(None = "",
"Double Quote" = '"',
"Single Quote" = "'"),
selected = '"'),
# Horizontal line ----
tags$hr(),
# Upload Button
actionButton("uploadId", "Upload")
),
# Main panel for displaying outputs ----
mainPanel(
# # Output: Data file ----
uiOutput("manage"),
# Input: Select number of rows to display ----
uiOutput("select"),
# Display Button
actionButton("displayid", "Display"),
tableOutput("contents")
)
)
########### Server ###########
server <- function(input, output, session) {
# Copy uploaded files to local folder
observeEvent(input$uploadId,{
if (is.null(input$file1) ) { return(NULL) }
file.copy(from = input$file1$datapath, to = paste0('Selected_Files/',input$file1$name ) )
df <- list(file = input$file1$name , header= input$header,
sep = input$sep,dec = input$dec,
quote = input$quote,
index = input$uploadId)
if(input$uploadId > 1){
old_df <- readRDS("File_Format.rds")
df <- sapply(names(old_df),function(n){c(old_df[[n]],df[[n]])},simplify=FALSE)
}
saveRDS(df, "File_Format.rds")
})
# Load all the uplaoded files to a list
datasetlist <- eventReactive(input$uploadId,{
# Selected_Files <- list.files("Selected_Files/")
File_Format <- readRDS("File_Format.rds")
datalist <- list()
datalist <- lapply(1:length(File_Format[[1]]), function(d) read.csv(paste0("Selected_Files/",File_Format$file[d] ),
header = File_Format$header[d],
sep = File_Format$sep[d],
dec = File_Format$dec[d],
quote = File_Format$quote[d]))
names(datalist) <- paste(File_Format$index, File_Format$file,sep = ". ")
return(datalist)
})
output$manage <- renderUI({
data <- datasetlist()
selectInput("dataset", "Dataset", choices = names(data), selected = names(data))
})
output$select <- renderUI({
data <- datasetlist()
radioButtons("disp", "Display", choices = c(Head = "head",All = "all"),
selected = "head")
})
# Display Selected File
observeEvent(input$displayid, {
output$contents <- renderTable({
data <- datasetlist()
sub_df <- data[[paste0(input$dataset)]]
if (isolate(input$disp == "head")) {
return(head(sub_df))
}
else {
return(sub_df)
}
})
})
}
shinyApp(ui, server)
希望这会有所帮助。
答案 1 :(得分：0)
类似的事情应该可以做到。由于您只提供了一半的代码，因此我没有进行过测试，现在我很懒惰来构建自己的ui文件。
server <- function(input, output) {
rv <- reactiveValues(
datasetlist = list()
)
observe({
# input$file1 will be NULL initially. After the user selects
# and uploads a file, head of that data file by default,
# or all rows if selected, will be shown.
req(input$file1)
input$update
tryCatch({
df <- read.csv(
input$file1$datapath,
header = isolate(input$header),
sep = isolate(input$sep),
dec = isolate(input$dec),
quote = isolate(input$quote)
)
},
error = function(e) {
# return a safeError if a parsing error occurs
stop(safeError(e))
})
# when reading semicolon separated files,
# having a comma separator causes `read.csv` to error
isolate(
rv$datasetlist = c(rv$datasetlist,list(df))
)
})
observe({
updateSelectInput(
session = session,
inputId = "selected_dataset",
choices = 1:length(rv$datasetlist),
selected = input$selected_dataset
)
})
output$contents <- renderTable({
req(length(rv$datasetlist) >= input$selected_dataset)
df <- rv$datasetlist[[input$selected_dataset]]
if (isolate(input$disp == "head")) {
return(head(df))
}
else {
return(df)
}
})
output$manage <- renderUI({
tagList(
selectInput("selected_dataset", "Dataset", choices = 1, selected = 1)
)
})
}
您可能必须在as.numeric()周围添加一些input$selected_dataset，因为selectInput通常返回字符串而不是数字。
希望这会有所帮助！！