如何在Shiny应用中实现带分组和图标装饰的下拉输入？

可以借助shinyWidgets包的pickerInput组件实现需求，该组件支持选项分组、自定义HTML内容（包括图标），以下是完整实现示例：

完整代码 #

library(shiny)
library(shinyWidgets)

ui <- fluidPage(
  tags$head(
    # 引入Font Awesome图标样式
    tags$link(rel = "stylesheet", href = "https://cdnjs.cloudflare.com/ajax/libs/font-awesome/4.7.0/css/font-awesome.min.css")
  ),
  
  titlePanel("带分组与图标的下拉选择"),
  
  sidebarLayout(
    sidebarPanel(
      pickerInput(
        inputId = "grouped_icon_picker",
        label = "选择工具",
        # 定义分组与带图标的选项
        choices = list(
          "办公工具" = list(
            "<i class='fa fa-file-word-o'></i> Word文档" = "word",
            "<i class='fa fa-file-excel-o'></i> Excel表格" = "excel",
            "<i class='fa fa-powerpoint'></i> PPT演示" = "ppt"
          ),
          "通讯工具" = list(
            "<i class='fa fa-weixin'></i> 微信" = "wechat",
            "<i class='fa fa-qq'></i> QQ" = "qq",
            "<i class='fa fa-envelope-o'></i> 邮箱" = "email"
          ),
          "开发工具" = list(
            "<i class='fa fa-code'></i> 代码编辑器" = "editor",
            "<i class='fa fa-github'></i> GitHub" = "github"
          )
        ),
        choicesOpt = list(html = TRUE), # 允许渲染HTML格式的选项
        options = list(
          iconBase = "fa",
          liveSearch = TRUE, # 开启实时搜索功能
          style = "btn-primary", # 设置按钮样式
          size = "normal" # 下拉框尺寸
        ),
        selected = "word" # 默认选中项
      )
    ),
    
    mainPanel(
      h4("选中结果："),
      verbatimTextOutput("selected_value")
    )
  )
)

server <- function(input, output) {
  output$selected_value <- renderPrint({
    input$grouped_icon_picker
  })
}

shinyApp(ui, server)

关键说明 #

• 分组设置：通过嵌套列表定义分组，外层列表的名称即为分组标题，内层列表是该分组下的选项
• 图标添加：在选项标签中嵌入Font Awesome的<i>标签，配合choicesOpt = list(html = TRUE)确保HTML内容被正确渲染
• 功能增强：通过options参数可添加实时搜索、自定义按钮样式等功能，提升交互体验

内容的提问来源于stack exchange，提问作者Stéphane Laurent