根据向量长度动态创建 selectInput id答案

【问题标题】：Dynamically create selectInput ids based on vector length根据向量长度动态创建 selectInput id
【发布时间】：2019-12-20 02:31:43
【问题描述】：

我正在创建一个 Shiny 应用程序，它需要某些 divs 具有相同的下拉菜单，但我需要给每个 div 一个唯一的 id，以便我可以访问它们的 input$id。

我创建了一个函数来基于值向量创建 div，当向量中的值为 ttest 时，还应该创建一个 selectInput。

但是，如果我在初始向量中有多个 ttest 值，我该如何制作选择输入 ttest_1、ttest_2 等的 ID？

# create a vector with 2 ttest values
test <- c("ttest", "mean", "freq", "ttest")

library(shiny)

# create divs, either just print the name in the vector
# or if the name in the vector is "ttest" then make it a select input
aggBlocks <- function(data, name)
{
  div(style = "
      text-align: center;
      font-size: 12px;
      background-color: #A9A9A9;
      border-radius: 10px;
      color: black; margin-bottom: 5px;
      ",
      if (name == "ttest") {
        # how do I abstractly make the ids ttest_1 and ttest_2 
        # based on the occurances in the vector?
        selectInput(paste0("ttest"), "T-TEST", choices = c("Week 1", "Week 2", "Week 3"), selectize = FALSE)
      } else {
        name
      }
  )
}


ui <- fluidPage(
  div(lapply(test, aggBlocks, data = test)),
  verbatimTextOutput("debug")

)

server <- function(input, output) {

  output$debug <- renderPrint({
    # rather than just print input$ttest
    # need to print ttest_1, ttest_2 etc
    input$ttest
  })

}


shinyApp(ui = ui, server = server)

任何帮助表示赞赏！

【问题讨论】：

标签： r shiny apply lapply

【解决方案1】：

您可以使用make.unique 为test 向量赋予唯一名称，该向量可用作ID。然后，您可以与grepl 进行部分匹配，而不是在aggBlocks 函数中进行完全匹配。

test <- c("ttest", "mean", "freq", "ttest")
library(shiny)

aggBlocks <- function(name)
{
  div(style = "
      text-align: center;
      font-size: 12px;
      background-color: #A9A9A9;
      border-radius: 10px;
      color: black; margin-bottom: 5px;
      ",
      if (grepl('^ttest', name)) {
        selectInput(name, "T-TEST", choices = c("Week 1", "Week 2", "Week 3"), 
          selectize = FALSE)
       } else {
         name
       }
     )
}

ui <- fluidPage(
  div(lapply(make.unique(test), aggBlocks)),
  verbatimTextOutput("debug")
)

server <- function(input, output) {
  output$debug <- renderPrint({
   input$ttest
 })
}

shinyApp(ui = ui, server = server)

【讨论】：