0

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

用户界面代码片段：

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]]]as 在添加或删除数字输入后实例化要保留的值。但是，我想从向量中提取值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'
4

1 回答 1

2

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

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

生成的小部件的 ID 始终由checkboxGroupInput. 所以，input$checkboxgrp说应该为哪个级别的 setosa 生成一个小部件。同时input$checkboxgrp给出生成的widget的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())
  })

}
于 2016-07-23T21:03:22.280 回答