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

时间:2019-12-20 02:31:43

标签: r shiny apply lapply

我正在创建一个Shiny应用程序,该应用程序要求某些divs具有相同的下拉菜单,但是我需要为每个div赋予一个唯一的ID,以便可以访问其input $ id。

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

但是如果我在初始向量中有多个ttest_1值,该如何使选择输入ttest_2ttest等的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)

任何帮助表示赞赏!

1 个答案:

答案 0 :(得分:0)

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

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)