如何在Shiny Dashboard侧边栏的menuSubItem下添加输入组件？

问题描述 #

尝试在Shiny应用侧边栏的menuSubItem下添加pickerInput组件，但运行后组件并未显示，仅能在menuItem下成功添加组件。

尝试代码：

library(shiny)
library(shinyWidgets)
library(shinydashboard)

ui <- dashboardPage(
  
  ### Header -----
  
  dashboardHeader(title = "Example App"),
  
  ### Sidebar -----
  
  dashboardSidebar(
    
    sidebarMenu(
              
      menuItem(
        text = "A",
        tabName = "analytics",
        icon = icon("signal"),
        startExpanded = TRUE,
        
        menuSubItem(text = "a",
                    icon = NULL,
                    
                    pickerInput(
                      inputId = "Id086",
                      label = "Placeholder", 
                      choices = c("a", "b", "c", "d"),
                      options = list(
                        title = "This is a placeholder")
                    )
                    ),
        
        
        menuSubItem(text = "b",
                    icon = NULL)
        
        
      )
      
    )
    
  ),
  
  dashboardBody(
    
  )
  
)

## Server-function -----

server <- function(input, output) {
  
  
}

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

解决方案 #

menuSubItem的设计目标是生成侧边栏的子菜单链接，不支持直接嵌套输入组件。要实现需求，可以通过以下两种方式：

方式一：自定义HTML结构替代menuSubItem #

直接构建包含文本和输入组件的HTML列表项，将其作为menuItem的子元素：

library(shiny)
library(shinyWidgets)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = "Example App"),
  dashboardSidebar(
    sidebarMenu(
      menuItem(
        text = "A",
        tabName = "analytics",
        icon = icon("signal"),
        startExpanded = TRUE,
        # 自定义HTML子项，包含文本和pickerInput
        tags$li(
          class = "treeview-menu menu-open",
          tags$span("a"),
          pickerInput(
            inputId = "Id086",
            label = "Placeholder", 
            choices = c("a", "b", "c", "d"),
            options = list(title = "This is a placeholder")
          )
        ),
        menuSubItem(text = "b", icon = NULL)
      )
    )
  ),
  dashboardBody()
)

server <- function(input, output) {}

shinyApp(ui = ui, server = server)

方式二：添加组件后用CSS缩进对齐 #

在menuSubItem之后直接放置输入组件，通过CSS设置左外边距，让组件看起来属于该子菜单的下方：

library(shiny)
library(shinyWidgets)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = "Example App"),
  dashboardSidebar(
    sidebarMenu(
      menuItem(
        text = "A",
        tabName = "analytics",
        icon = icon("signal"),
        startExpanded = TRUE,
        
        menuSubItem(text = "a", icon = NULL),
        # 添加pickerInput并设置缩进
        tags$div(
          style = "margin-left: 25px; margin-bottom: 10px;",
          pickerInput(
            inputId = "Id086",
            label = "Placeholder", 
            choices = c("a", "b", "c", "d"),
            options = list(title = "This is a placeholder")
          )
        ),
        
        menuSubItem(text = "b", icon = NULL)
      )
    )
  ),
  dashboardBody()
)

server <- function(input, output) {}

shinyApp(ui = ui, server = server)

内容的提问来源于stack exchange，提问作者Philipp Schulz