Question

我有一个Shiny应用程序，其中包含许多下拉选择框，其值通过读取RDS文件来填充。该应用程序还包括一个fileInput函数来上传新数据。如何更改下拉框中的值以反映新数据？目前我可以看到数据已上传，但旧数据仍保留在下拉列表中。

应使用

将应上传的数据保存到文件中

saveRDS( data.frame(names=c("Jill","Jane","Megan")),"myDataFrame.rds")

在我的app.R文件中，我首先定义数据的'default'值：

myDataFrame <- data.frame(names=c("Tom","Dick","Harry"))

我app.R的内容如下：

library(shiny)
ui <- shinyUI(
 fluidPage(
  fileInput('file1', 'Choose file to upload',accept = ".rds"),
  selectInput("myNames","Names",myDataFrame$names),
  tableOutput('contents')
 )
)

server <- shinyServer(function(input, output) {
  output$contents <- renderTable({
    inFile <- input$file1
    if (is.null(inFile)) { return(myDataFrame) }
    readRDS(inFile$datapath)
  })
  })

应用程序的初始视图符合预期：下拉列表和表格都包含“默认”名称。上传包含新数据帧的RDS文件后，表格会发生变化（这就是我要查找的内容），但下拉值不会。我怎样才能让后者发生？

Answer 1

我添加了您必须用于表myData的反应对象contents，但更重要的是更新selectInput中的选项（选中observe和updateSelectInput一部分）。

library(shiny)

ui <- shinyUI(
    fluidPage(
        fileInput("file1", "Choose file to upload", accept = ".rds"),
        selectInput("myNames","Names", ""),
        tableOutput("contents")
    )
)

server <- function(input, output, session) {

    myData <- reactive({
        inFile <- input$file1
        if (is.null(inFile)) {
            d <- myDataFrame
        } else {
            d <- readRDS(inFile$datapath)
        }
        d
    })

    output$contents <- renderTable({
        myData()
    })

    observe({
         updateSelectInput(session, "myNames",
                           label = "myNames",
                           choices = myData()$names,
                           selected = myData()$names[1])
    })

}

shinyApp(ui, server)

Answer 2

关于@PoGibas的回答，我需要为应用加载多个列表值，这是使用reactiveValues和observeEvent的类似应用：

library(shiny)

# save a dummy RDS for loading
saveRDS(list(names=LETTERS,numbers=seq(10)),'dummy.rds')
# define initial values
myDataList <- list(names=c("Tom","Dick","Harry"), numbers=seq(5))

ui <- shinyUI(
  fluidPage(
    fileInput("file1", "Choose file to upload", accept = ".rds"),
    selectInput("myNames","Names", ""),
    selectInput("myNumbers","Numbers", ""),
    tableOutput("contents")
  )
)

server <- function(input, output, session) {

  md <- reactiveValues(
    names = myDataList$names,
    numbers = myDataList$numbers
  )

  observeEvent(input$file1,{
      d <- readRDS(input$file1$datapath)
      for (n in names(d)){
        md[[n]] <- d[[n]]
      }
  })

  output$contents <- renderTable({
   data.frame(data = c(md$names,md$numbers))
  })

  observe({
    updateSelectInput(session, "myNames",
                      label = "myNames",
                      choices = md$names,
                      selected = md$names[1])
    updateSelectInput(session, "myNumbers",
                      label = "myNumbers",
                      choices = md$numbers,
                      selected = md$numbers[1])
  })
}

shinyApp(ui, server)

使用fileInput

2 个答案: