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

Question

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

中使用 paste(input, i)

ui 代码片段：

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")

服务器代码片段：

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。这就是为什么您不需要将 "active" 小部件的 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())
  })

}

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

Extracting values of input widgets after updating dynamic UI using renderUI()

r

dynamic-ui

shiny

编辑