如何使用上传的 csv 文件更新反应列表

Question

我一直在为 Shiny reactiveValuesToList 构造而苦苦挣扎。目标是允许用户从预加载和上传的 csv 文件中选择列表。我的想法是上传的每个 CSV 都是一个“命名列表”。 csv 表的每一列都是“列表”，列标题作为名称。然后可以选择每个列表的元素并将其用作其他功能的输入。

我想我不太了解 reactiveListToValues，无法弄清楚如何让 Shiny 响应式更新上传的 csv 信息。

这是一个示例 CSV。

> read.csv("~/scratch/tmp/mydummy.csv", header=T)
   madeup1 madeup2
1      332    6836
2     9582    6184
3      983   79139
4   144455   79174
5    90701     669
6     4189   51566
7    10959    7873
8     4247    4189
9    60559     419
10    4247   13367
11    1959     787
12     447     489
13    6559     419
14     447   13367

下面的代码可以按原样运行。非常感谢您的建议和帮助！

## load libraries
library(shiny)
library(stringr)

customList <- list("custom1" = c("5825","6604","55037","952","55037","55037"),
                    "custom2" = c("23386","945","11314","951","11314","51495"),
                    "custom3" = c("51495","55037","26005"))

## ShinyUI 
ui <- fluidPage(
        titlePanel("Uploading Files"),
          sidebarLayout(
            sidebarPanel(
             width =3,
             fileInput('file1', 'Choose CSV file', accept=c('txt/csv','text/comma-separated-values,text/plain','.csv')),
             tags$hr(),
             checkboxInput('header','Header', TRUE),
             radioButtons('sep','Separator', c(Comma=',',Semicolon=';',Tab='\t'), ','),
             radioButtons('quote','Quote', c(None ='',
                                             'Double Quote'='"', 
                                             'Single Quote'="'"),'"'),
             selectInput("DBname", label=h6("Select databases:"),
                         choices = c("custom" = "customList", "uploaded" = "upload_List")),
             selectInput("path_name", label=h6("Select list"),
                         choices=""),
             selectInput("elem_name", label=h6("Select element"),
                         choices="")
             ),

            mainPanel(
              column(12,
                tabsetPanel(type="tabs",
                  tabPanel("CSV File", 
                    tableOutput('contents'), verbatimTextOutput('contents2'), 
                    verbatimTextOutput('contents3')
                    )
                  )
                )
              )
           )
        )

#ShinyServer ##################################################################
server <- function(input, output, session) {
  ## under CSV tab
  output$contents <- renderTable({
    inFile <- input$file1
    if (is.null(inFile))
      return(NULL)
    read.csv(inFile$datapath, header=input$header, sep=input$sep, quote=input$quote)
  })
  output$contents2 <- renderPrint(upload_List$dList)
  output$contents3 <- renderPrint(customList)

  #____________________________________________________________________________
  upload_List <- reactiveValues()
  upload_List$fList <- c(isolate(upload_List$fList), list('same_as_custom1' = customList$custom1))

  #____________________________________________________________________________
  observe({
    inFile <- input$file1
    if (is.null(inFile)) ## need action button?
      return(NULL)
    a <- read.csv(inFile$datapath, header=input$header, sep=input$sep, quote=input$quote, colClasses="character")
    b <- lapply(a, as.character) ## break out the list and instead call by index
    upload_List$dList <- c(isolate(upload_List$dList), b[1) ## new        
    #upload_List$dList <- c(isolate(upload_List$dList), lapply(a, as.character))
  })

  #____________________________________________________________________________
## incorrect use of reactiveValueToList
  ##upload.asList <- isolate(reactiveValuesToList(upload_List))

  #____________________________________________________________________________
  DBname <- reactive(input$DBname)
  pathVar <- reactive({
    `if`(str_detect(input$DBname, "custom"), names(customList), 
         `if`(str_detect(input$DBname, "upload"), names(upload_List), ##names(upload_List$dList),
              customList$custom3 ))
  })

  #____________________________________________________________________________
  path_name <- reactive(input$path_name)
  observe({
    updateSelectInput(session, "path_name", choices = pathVar())
  })  

  #____________________________________________________________________________
  elem_name <- reactive(input$elem_name)
  observe({
    updateSelectInput(session, "elem_name", choices = elemVar())
  })

  elemVar <- reactive({
    eval(as.symbol(DBname()))[[path_name()]]
    })
}

## shinyApp
shinyApp(ui, server)

Answer 1

从技术上讲，我认为您的问题可以通过简单地使用 elemVar 响应式的定义来解决：

  elemVar <- reactive({
   # eval(as.symbol(DBname()))[[path_name()]]
    if(str_detect(input$DBname,"custom")) return(customList[[path_name()]]) 
    if(str_detect(input$DBname,"upload")) return(upload_List$dList[[path_name()]])
  })

当您选择上传的数据时，“选择元素”选项未更新的问题随即消失。您试图使用upload_List[[path_name()]] 来获取它们，但它们存储在upload_List$dList[[path_name()]]

然而，所有这些代码对我来说似乎都非常复杂，很确定你可以用reactive 函数和一个reactiveValue 来更简单地编写它来存储上传的数据帧。我认为 observe 或 isolate 函数中的任何一个都不是必需的，它们会严重混淆事物。