使用 renderUI() 更新动态 UI 后提取输入小部件的值

Question

我已经通过 renderUI() 成功地更新了 UI。我有一长串可供选择的输入。复选框用于动态添加数字输入。因此，为了实现这一点，我使用了 lapply。但是，我使用了 checkboxgroup 本身中选定复选框的值来填充动态添加的数字输入的 ID，而不是在 lapply 中使用 paste(input, i)。

用户界面代码 sn-p：

checkboxGroupInput(inputId = "checkboxgrp", label = "Select types",
                       choices = list("ELECTAPP","NB W $","PUR","MANUAL LTR","REDEMPTION","NB W TRANSFER","NB WOUT $","OUTPUT")),
...    
fluidRow(column(12, verbatimTextOutput("value")))
...
uiOutput("numerics")

服务器代码 sn-p：

renderUI({
    numInputs <- length(input$checkboxgrp)

    if(numInputs==0){
      wellPanel("No transaction selected")
    }
    else{
      lapply(1:numInputs, function(i){
        x[i]=input$checkboxgrp[i]
        list(numericInput(input$checkboxgrp[i], min = 0, label = input$checkboxgrp[i], 
                         value= input[[x[i]]] ))
      })
    }
  })
  output$value <- renderPrint({
    numInputs <- length(input$checkboxgrp)
    lapply(1:numInputs, function(i){
      print(input[[x[i]]]) ## ERROR
    })
  })

我使用input[[x[i]]] 来实例化添加或删除数字输入后要保留的值。但是，我想将 input$x[i] 或 input[[x[i]]] 中的值提取到一个向量中以供进一步使用，这是我无法做到的。

*ERROR:Must use single string to index into reactivevalues

感谢任何帮助。

---

编辑

使用 3 种不同的方式从输入中提取值会产生 3 种不同的错误： 使用print(input$x[i]) # ERROR

NULL
NULL
NULL
NULL
[[1]]
NULL

[[2]]
NULL

[[3]]
NULL

[[4]]
NULL

使用print(input[[x[i]]]) # ERROR

Must use single string to index into reactivevalues

使用print('$'(input, x[i])) # ERROR

invalid subscript type 'language'

Answer 1

如果我理解正确，您希望访问动态生成的小部件的值，然后将它们打印出来。

在下面的示例中，应该很容易概括，选择是来自 iris 数据集的变量 Setosa 的级别。

生成的小部件的 ID 始终由 checkboxGroupInput 中的选定值给出。所以，input$checkboxgrp 告诉闪亮应该为哪个级别的 setosa 生成一个小部件。同时input$checkboxgrp 给出生成的小部件的ID。这就是为什么您不需要将“活动”小部件的 ID 存储在其他变量 x（这可能是一个反应值）中。

要打印出这些值，您可以执行以下操作：

 output$value <- renderPrint({

     activeWidgets <- input$checkboxgrp
     for (i in activeWidgets) {
       print(paste0(i, " = ", input[[i]]))
     }
   })

---

print(input[[x[i]]]) ## ERROR 这一行会产生错误，因为x[i]（不管它是什么）不是具有单个值而是具有多个值的向量。

---

完整示例：

library(shiny)

ui <- fluidPage(

   titlePanel("Old Faithful Geyser Data"),

   sidebarLayout(
      sidebarPanel(
         checkboxGroupInput("checkboxgrp", "levels", levels(iris$Species))
      ),
      mainPanel(
        fluidRow(
          column(6, uiOutput("dynamic")),
          column(6, verbatimTextOutput("value"))
        )
      )
   )
)

server <- function(input, output) {

   output$dynamic <- renderUI({

     numInputs <- length(input$checkboxgrp)

     if(numInputs==0){
       wellPanel("No transaction selected")
     }
     else{
       lapply(1:numInputs, function(i){
         x[i]=input$checkboxgrp[i]
         list(numericInput(input$checkboxgrp[i], min = 0, label = input$checkboxgrp[i], 
                           value= input[[x[i]]] ))
       })
     }
   })

   output$value <- renderPrint({

     activeWidgets <- input$checkboxgrp
     for (i in activeWidgets) {
       print(paste0(i, " = ", input[[i]]))
     }
   })

}


shinyApp(ui = ui, server = server)

---

编辑：

您可以稍微调整lapply 部分（注意<<- 运算符:)）

 else{
       activeWidgets <- input$checkboxgrp
       val <- 0
       lapply(activeWidgets, function(i){
         val <<- val + 1
         list(numericInput(i, min = 0, label = i, 
                           value = val ))
       })
     }

编辑 2 回复评论：

server <- function(input, output) {

  output$dynamic <- renderUI({

    numInputs <- length(input$checkboxgrp)

    if(numInputs==0){
      wellPanel("No transaction selected")
    }
      else{
        activeWidgets <- input$checkboxgrp
        val <- 0
        lapply(activeWidgets, function(i){
          val <<- val + 1
          list(numericInput(i, min = 0, label = i, 
                            value = val ))
        })
      }
  })

  allChoices <- reactive({
    # Require that all input$checkboxgrp and 
    # the last generated numericInput are available.
    # (If the  last generated numericInput is available (is not NULL),
    # then all previous are available too)

    # "eval(parse(text = paste0("input$", input$checkboxgrp))))" yields
    # a value of the last generated numericInput. 

    # In this way we avoid multiple re-evaulation of allChoices() 
    # and errors
    req(input$checkboxgrp, eval(parse(text = paste0("input$", input$checkboxgrp))))

    activeWidgets <- input$checkboxgrp
    res <- numeric(length(activeWidgets))
    names(res) <- activeWidgets
    for (i in activeWidgets) {
      res[i] <- input[[i]]

    }
    res
  })

  output$value <- renderPrint({
    print(allChoices())
  })

}