使用renderUI（）

Question

我已成功通过renderUI（）动态更新UI。我有很多输入可供选择。复选框用于动态添加数字输入。所以，为了实现这一点，我使用了lapply。但是，我在checkboxgroup本身中使用了选中复选框的值来填充动态添加的数字输入的ID，而不是使用lapply中的paste（input，i）。

ui code snippet：

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。这就是为什么你不需要存储＆＃34;活跃＆＃34;的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())
  })

}