R + Shiny: Сохранить загруженный набор данных в список / выбрать элемент списка для просмотра

Question

Я просмотрел весь интернет и попробовал несколько решений, но ни одно из них, похоже, не работает. Короче говоря, это моя проблема: я создал блестящее приложение, где пользователь может загружать 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)

Answer 1

Скопируйте загруженные файлы пользователем в папку, скажем, Selected_Files, используя file.copy(), затем используйте eventReactive(), чтобы прочитать все файлы в папке в список, скажем, набор данных. Присвойте элементам списка данных имена файлов. Вы можете использовать этот реактивный контекст списка в renderUI / renderTable, используя datasetlist().

Я написал приведенный ниже код, который может решить вашу задачу. Дополнительное примечание read.csv имеет аргумент sep, который заботится о различных разделителях. Я использовал radioButtons для пользователя, чтобы обеспечить разделители файлов.

Редактировать: Чтобы правильно отразить формат всех загруженных файлов, я создал список df, записывающий пользовательские форматы входных файлов и сохраняющий его как объект R 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)

Надеюсь, это было полезно.

Answer 2

Что-то вроде этого должно сделать это. Я не проверял его, поскольку вы предоставили только половину своего кода, и сейчас мне лень создавать собственный пользовательский файл.

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 обычно возвращает строку, а не число.

Надеюсь, это поможет!