带有命名选项组和一个未命名选项组的闪亮 selectInput

Question

我需要一个包含某些选项组的下拉菜单，第一个选项是“使用所有数据”。该选择构成了它自己的选项组，并且该组不需要名称。
不幸的是， selectInput() 不允许这样做。要么所有选项组都必须是名称，要么都不能。我尝试使用 htmltools 和 tagQuery() 操作标签，但无法访问各个 optgroup-header 标签。

代表：

library(shiny)

grouped_options <- list(
  "Named category 1" =
    list(
      "list_choice1"
    ),
# this category shouldn't have a visible name
  "NONAME" = 
    list(
      "list_choice2",
      "list_choice3"
    ),
  "Named category 2" = 
    list(
      "list_choice5",
      "list_choice6"
    )
)

dropdown_element <- selectInput(inputId = "dd1",
                        label = "Dropdown menu with categorised options",
                        choices = grouped_options)

ui <- fluidPage(
  h1("Demo dropdown with categories"),
  dropdown_element,
  textOutput("sel_choice")
  )
)

server <- function(input, output, session) {
  output$sel_choice <- renderText(input$dd1)
}

shinyApp(ui, server)

Answer 1

我已经成功编写了一个 hack 来使用 CSS 来完成此任务：

library(shiny)

grouped_options <- list(
  "Named category 1" =
    list(
      "list_choice1"
    ),
  "NONAME" = 
    list(
      "list_choice2",
      "list_choice3"
    ),
  "Named category 2" = 
    list(
      "list_choice5",
      "list_choice6"
    )
)

dropdown_element <- selectInput(inputId = "dd1",
                        label = "Dropdown menu with categorised options",
                        choices = grouped_options)

ui <- fluidPage(
  h1("Demo dropdown with categories"),
  dropdown_element,
  textOutput("sel_choice"),
  # CSS to reduce font size to invisibility
  tags$style(HTML("
  div[data-group='NONAME'] > .optgroup-header {
    font-size:0px
  }
  "
  ))
)

server <- function(input, output, session) {
  output$sel_choice <- renderText(input$dd1)
}

shinyApp(ui, server)

名为 NONAME 的选项组的名称将以 0px 的字体书写，从而有效地使其不可见。该选项组可以放置在选项列表中的任何位置。

一个缺点 - 您只能有一个名为 NONAME 的选项组。如果您需要更多，您应该调用新的 optgroup NONAME2 等，并使用这些名称复制 CSS 规则。
希望这对遇到类似情况的人有所帮助！