如何将R Shiny动态生成的用户输入值存储到dataframe中

核心修改点 #

• 将原未绑定变量的eventReactive赋值给响应式变量df
• 基于当前输入组计数循环提取所有动态生成的输入值，拼接为结构化dataframe
• 修正输出ID大小写不匹配问题：UI中定义的输出ID为Dataframe，服务端渲染逻辑需和该ID保持一致

完整修正后代码 #

library(shiny)

ui <- fluidPage(
 
  fluidRow(
    column(
      width = 6,
      uiOutput("selection_ui")
    ),
      
    column(
      width = 3,
      uiOutput("amount_ui")
    ),
    
    column(
      width = 3,
      uiOutput("year_ui")
    )
  ),
  
  fluidRow(
    column(
      width = 6,
      actionButton(inputId = "addEntry", 
                   label = "Add Entry")
    ),
    
    column(
      width = 6,
      actionButton(inputId = "deleteEntry",
                   label = "Delete Entry")
    )
  ),
  br(),
  
  fluidRow(
    column(
      width = 12,
      actionButton(inputId = "Go",
                   label = "Submit")
    )
  ),
  
  dataTableOutput("Dataframe")
)

server <- function(input, output){
  
  counter <- reactiveValues(value = 1)
  
  AllInputs <- reactive({
    x <- reactiveValuesToList(input)
  })
  
  observeEvent(input$addEntry, {
    counter$value <- counter$value + 1
  })
  
  observeEvent(input$deleteEntry, {
    req( counter$value >= 2 )
    counter$value <- counter$value - 1
  })
  
  selection <- reactive({
    n <- counter$value
    
    if(n > 0){
      isolate({
        lapply(seq_len(n), function(i){
          selectInput( inputId = paste0("select",i),
                       label = paste0(i, "-th selection:"),
                       choices = as.list(c("", "A", "B", "C")),
                       selected = AllInputs()[[paste0("select",i)]]
          )
        })
      })
    }
  })
  
  amount <- reactive({
    n <- counter$value
    
    if(n > 0){
      isolate({
        lapply(seq_len(n), function(i){
          numericInput(inputId = paste0("number",i),
                       label = paste0(i, "-th amount:"),
                       value = AllInputs()[[paste0("number",i)]])
        })
      })
    }
  })
  
  year <- reactive({
    n <- counter$value
    
    if(n > 0){
      isolate({
        lapply(seq_len(n), function(i){
          numericInput(inputId = paste0("year",i),
                       label = paste0(i, "-th year:"),
                       value = AllInputs()[[paste0("year",i)]])
        })
      })
    }
  })
  
  output$selection_ui <- renderUI({selection()})
  output$amount_ui <- renderUI({amount()})
  output$year_ui <- renderUI({year()})

  # 动态生成Dataframe逻辑
  df <- eventReactive(input$Go, {
    req(counter$value >= 1)
    # 循环提取每一组输入的值，拼成三列数据框
    data.frame(
      selection = sapply(seq_len(counter$value), function(i) input[[paste0("select", i)]]),
      amount = sapply(seq_len(counter$value), function(i) input[[paste0("number", i)]]),
      year = sapply(seq_len(counter$value), function(i) input[[paste0("year", i)]]),
      check.names = FALSE
    )
  })
  
  output$Dataframe <- renderDataTable(df())
}

shinyApp(ui = ui, server = server)

如果需要处理输入为空的场景，可以在提取输入值时补充空值默认逻辑，比如用input[[paste0("select", i)]] %||% NA替换直接取值的逻辑，即可避免空输入导致的报错。

内容的提问来源于stack exchange，提问作者Marcus Willems