R + Shiny : Save Uploaded Dataset to List/choose from list item to view

标签 r list shiny dataset

我查遍了互联网并尝试了多种解决方案,但似乎都不起作用。 简而言之,这是我的问题:我创建了一个 Shiny 的应用程序,用户可以在其中上传 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)

最佳答案

使用 file.copy() 将用户上传的文件复制到 Selected_Files 文件夹中,然后使用 eventReactive() 将文件夹中的所有文件读取到列表说数据集列表。将数据集列表的元素命名为文件名。您可以使用 datasetlist() 在 renderUI/renderTable 中使用此列表响应式(Reactive)上下文。

我编写了下面的代码,它可能会解决您的目的。进一步注意 read.csvsep 参数,它负责处理不同的分隔符。我使用单选按钮为用户提供文件分隔符。

编辑:为了正确捕获所有上传文件的文件格式,我创建了一个列表df,捕获用户输入文件格式并将其保存为 R 对象File_Format.rds 在工作目录中。然后使用 readRDS 将保存的列表加载为 old_df 并将其附加到当前 df

Edit2:我发现,当使用不同参数上传同一文件时,列表File_Format的名称保持相同,因此重复的第一个元素被选中。我通过将上传计数作为名称的索引作为前缀解决了这个问题。此外,在代码的开头,我添加了两条语句来删除 RDS 文件以及 Selected_Files 文件夹中的所有文件。因此,每当打开应用程序时,这些文件都会首先被删除,然后才是交互式 session 。

更新后的代码如下

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)

希望这对您有所帮助。

关于R + Shiny : Save Uploaded Dataset to List/choose from list item to view,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/52074498/

相关文章:

r - 分解 `…`参数并分配给多个函数

r - github 操作中的 Spotify 身份验证

python - python 列表中的无限赋值?

python - 比较相邻值、删除相似对并比较新列表

HTML/CSS 菜单样式栏布局不正确

r - 为什么我收到错误 : argument of length 0

javascript - 如何在 Shiny 应用程序中嵌入 Twitter 时间线

r - Shiny:使用 rhandsontable 在响应式(Reactive)数据集之间切换

c++ - 从 C++ 运行代码后解锁绑定(bind)(在 R 中)的问题

r - rpart 决策树中的 rel 误差和 x 误差有什么区别?