在 Shiny 中使用来自 tagList 的动态输入到 renderTable

Question

我要做的是让用户指定组数，然后根据指定的组数，UI 为每个组生成一个numericInput。然后我想用那个值来做一些其他的操作（在这个例子中，我正在制作一个均值表）。使用this example，我能够让它返回一些文本，但不能将该标签用作其他任何内容的输入。

当我尝试使用该信息（即，作为电抗导体）时，我收到“替换长度为零”错误。似乎闪亮没有识别更新的用户界面。我知道这可能与使用reactive 有关，但我不知道为什么它不起作用。这是我的代码：

library(shiny)
library(purrr)

# functions ---------------------------------------------------------------
## generic function that creates an input from an i
make_list = function(i, idname, labelname){
  idname <- paste(idname, i, sep = "")
  div(style="display: inline-block;vertical-align:top; width: 45%;",
      numericInput(idname, labelname, 0))
}

## make function that can be used within a loop
list_loop = function(i) {
  make_list(i, "mean", "Mean of Group ")
}


# UI ----------------------------------------------------------------------
# Define UI for application that draws a histogram
ui <- fluidPage(

  # Application title
  titlePanel("A Test Page"),

  sidebarLayout(
    sidebarPanel(width = 8,
        #### UI for groups
       numericInput("groups", "How many groups?", 4),
       hr(),
       uiOutput("inputMean")),

    # Main panel for displaying outputs ----
    mainPanel(width = 4,
              h3("Data Preview"),
              #textOutput("inputValues"),
              tableOutput("table"))
    )
)


# Server ------------------------------------------------------------------
# Define server logic required to draw a histogram
server = function(input, output) {

  ## loop through # of groups for all i and make the UI
  ## this is passed back to the UI
  observeEvent(input$groups, 
      {
        output$inputMean = renderUI(
          {
            mean_list <- 1:input$groups %>% map(~list_loop(.x))
            do.call(tagList, mean_list)
          }
        )
    }
  ) 

  ## return the inputnames
  ## This WORKS
  output$inputValues <- renderText({
    paste(lapply(1:input$groups, function(i) {
      inputName <- paste("mean", i, sep = "")
      input[[inputName]]
    }))
  })

  make_table = reactive({
    ### prepopulate a table
    d = data.frame(group = 1:input$groups)
    d$means = NA
    paste(lapply(1:input$groups, function(i) {
      inputName <- paste("mean", i, sep = "")
      # this fails because input is NULL at this point
      d$means[i] = input[[inputName]]
    }))
    d
  })

  output$table <- renderTable({
    make_table()
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

如果您将make_table 替换为以下内容，则可以。

我添加了一个req 来检查所有输入是否存在，因此它不会再抛出错误。然后，我使用您创建的lapply 填充了d$means。

  make_table = reactive({
    req(input$groups, input[[paste("mean", input$groups, sep = "")]])
    ### prepopulate a table
    d = data.frame(group = 1:input$groups)
    d$means = lapply(1:input$groups, function(i) {
      inputName <- paste("mean", i, sep = "")
      # this fails because input is NULL at this point
      input[[inputName]]
    })
    d
  })