R Shiny：如何使用上傳的 data.frame 擴展包含 data.frames 列表的反應？

Question

我為此苦苦掙扎了幾個小時：

在我的應用程序中，啟動應用程序時會加載一個簡單的測試數據集df 。 然后，用戶可以通過文件上傳添加更多數據集，然后從下拉菜單（此處為selectInput ）選擇他喜歡繼續使用的數據集。

我沒有做的事情：

啟動應用程序后，反應式df_list應該只包含初始數據集df並且下拉菜單應該只包含值c("", "df") 。 通過上傳（或其他方式）添加數據集后，應展開df_list （以及相應的下拉菜單）。 這樣我就有了一個列表，其中包含用戶可以從 select 中獲取的所有可用數據集。

但我只設法創建了兩個場景：下拉菜單包含df但添加數據集后我無法展開df_list 。 或者在我添加數據集之前下拉菜單保持空白，因此用戶必須先添加數據集才能使用測試數據集。

我的代碼示例：我通過創建 data.frame df_upload的 actionButton 來“模擬”文件上傳。 以下示例不嘗試使用附加數據集df_upload df_list

library(shiny)

# df available from start
df <- data.frame(Var = 1:10)

ui <- fluidPage(
  selectInput("select", label = "Select data", choices = c("")),
  actionButton("upload", "Simulate Upload"),
  tableOutput("tabdata")
)

server <- function(input, output, session) {
  
  # reactive that lists all datasets
  df_list <- reactive({list(df = df)})
  
  # 'upload' of second df
  df_upload <- eventReactive(input$upload, {
    data.frame(Var = 11:20)
  })
  
  # observes if df_list() gets expanded to update choices
  observeEvent(df_list(), {
    updateSelectInput(session = session,
                      inputId = "select",
                      choices = c("", names(df_list())))
  })
  
  # output of selected dataset
  output$tabdata <- renderTable({
    req(df_list())
    df_list()[[input$select]]
  }) 

}

shinyApp(ui, server)

這是我嘗試過的許多事情之一（這成功添加了df_upload ，但在啟動應用程序后最初無法在下拉菜單中顯示df ）：

library(shiny)

# df available from start
df <- data.frame(Var = 1:10)

ui <- fluidPage(
  selectInput("select", label = "Select data", choices = c("")),
  actionButton("upload", "Simulate Upload"),
  tableOutput("tabdata")
)

server <- function(input, output, session) {
  
  # reactive that lists all datasets
  df_list <- reactive({
    df_list <- list(df = df)
    
    # check if there is an uploaded df, and if yes add it to df_list
    # does not work, because it does not give me df_list only containing df 
    # in case no dataset was added yet.
    # is.null is not the proper way, because if df_upload does not exist yet,
    # it does not yield NULL. I also tried it unsuccessfully 
    # with exists("df_upload()")
    if (!is.null(df_upload())) {
      df_list[[2]] <- df_upload()
      names(df_list)[2] <- "df_upload"
    }
    return(df_list)
  })
  
  # 'upload' of second df
  df_upload <- eventReactive(input$upload, {
    data.frame(Var = 11:20)
  })

  # observes if df_list() gets expanded to update choices
  observeEvent(df_list(), {
    updateSelectInput(session = session,
                      inputId = "select",
                      choices = c("", names(df_list())))
  })
  
  # output of selected dataset
  output$tabdata <- renderTable({
    req(df_list())
    df_list()[[input$select]]
  })
  
}

shinyApp(ui, server)

Answer 1

基於@Limey 的評論使用 reactiveValues 的簡單解決方案：

library(shiny)

# df available from start
df <- data.frame(Var = 1:10)

reactlog::reactlog_enable()

ui <- fluidPage(
  selectInput("select", label = "Select data", choices = c("df")),
  actionButton("upload", "Simulate Upload"),
  tableOutput("tabdata")
)

server <- function(input, output, session) {
  
  # empty reactiveValues rv to store all datasets in
  rv <- reactiveValues()
 
  # store the test df in rv
  rv$df <- df
  
  # 'upload' of second df and storing it in rv
   observeEvent(input$upload, {
     rv$df_upload <- data.frame(Var = 11:20)
  })
  
  # update selectInput choices 
  observe({
    updateSelectInput(session = session,
                      inputId = "select",
                      choices = names(rv),
                      selected = "df")
  })
  
  # output of selected dataset
  output$tabdata <- renderTable({
    rv[[input$select]]
  })

}

shinyApp(ui, server)