如何在Shiny中实现手风琴式侧边栏布局？

一、使用bsplus包实现 #

bsplus包的bs_accordion_sidebar()可直接创建手风琴式侧边栏，配合bs_accordion_sidebar_append()添加带标题的折叠面板，面板内可放入selectInput、numericInput等控件。

步骤与示例代码 #

1. 安装并加载包：

install.packages("bsplus")
library(shiny)
library(bsplus)

2. 修改UI部分，替换原sidebarPanel为手风琴侧边栏：

ui <- fluidPage(
  titlePanel("Hello Shiny!"),
  sidebarLayout(
    # 手风琴式侧边栏
    sidebarPanel(
      bs_accordion_sidebar(id = "acc_sidebar") %>%
        bs_accordion_sidebar_append(
          title = "数据筛选",
          content = tagList(
            selectInput(inputId = "data_type",
                        label = "选择数据类型",
                        choices = c("等待时间", "喷发时长")),
            numericInput(inputId = "threshold",
                         label = "阈值",
                         value = 50,
                         min = 1,
                         max = 100)
          )
        ) %>%
        bs_accordion_sidebar_append(
          title = "直方图设置",
          content = sliderInput(inputId = "bins",
                                label = "Number of bins:",
                                min = 1,
                                max = 50,
                                value = 30)
        )
    ),
    mainPanel(
      plotOutput(outputId = "distPlot")
    )
  )
)

server <- function(input, output) {
  output$distPlot <- renderPlot({
    # 根据选择切换数据
    x <- if(input$data_type == "等待时间") faithful$waiting else faithful$eruptions
    bins <- seq(min(x), max(x), length.out = input$bins + 1)
    
    hist(x, breaks = bins, col = "#75AADB", border = "white",
         xlab = if(input$data_type == "等待时间") "Waiting time to next eruption (in mins)" else "Eruption duration (in mins)",
         main = "Histogram of geyser data")
  })
}

shinyApp(ui = ui, server = server)

二、其他替代方案 #

1. 使用bslib包（官方推荐，支持Bootstrap 5） #

bslib是Shiny官方的Bootstrap扩展包，其accordion()函数简洁且兼容性更好，适合现代UI需求：

install.packages("bslib")
library(shiny)
library(bslib)

ui <- fluidPage(
  theme = bs_theme(version = 5),
  titlePanel("Hello Shiny!"),
  sidebarLayout(
    sidebarPanel(
      accordion(
        id = "acc",
        accordion_panel(
          title = "数据筛选",
          selectInput(inputId = "data_type",
                      label = "选择数据类型",
                      choices = c("等待时间", "喷发时长")),
          numericInput(inputId = "threshold",
                       label = "阈值",
                       value = 50,
                       min = 1,
                       max = 100)
        ),
        accordion_panel(
          title = "直方图设置",
          sliderInput(inputId = "bins",
                      label = "Number of bins:",
                      min = 1,
                      max = 50,
                      value = 30)
        )
      )
    ),
    mainPanel(
      plotOutput(outputId = "distPlot")
    )
  )
)

server <- function(input, output) {
  output$distPlot <- renderPlot({
    x <- if(input$data_type == "等待时间") faithful$waiting else faithful$eruptions
    bins <- seq(min(x), max(x), length.out = input$bins + 1)
    
    hist(x, breaks = bins, col = "#75AADB", border = "white",
         xlab = if(input$data_type == "等待时间") "等待时间（分钟）" else "喷发时长（分钟）",
         main = "间歇泉数据直方图")
  })
}

shinyApp(ui = ui, server = server)

2. 使用shinydashboard包（适合仪表盘布局） #

如果应用采用仪表盘风格，shinydashboard的sidebarMenu支持可折叠菜单项，实现类似手风琴效果：

install.packages("shinydashboard")
library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = "Hello Shiny!"),
  dashboardSidebar(
    sidebarMenu(
      id = "sidebar_menu",
      menuItem("数据筛选", tabName = "filter", icon = icon("filter"),
               menuSubItem("数据类型选择", tabName = "data_type"),
               menuSubItem("阈值设置", tabName = "threshold")
      ),
      menuItem("直方图设置", tabName = "hist", icon = icon("chart-bar"),
               sliderInput(inputId = "bins",
                           label = "Number of bins:",
                           min = 1,
                           max = 50,
                           value = 30)
      )
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "data_type",
              selectInput(inputId = "data_type",
                          label = "选择数据类型",
                          choices = c("等待时间", "喷发时长"))),
      tabItem(tabName = "threshold",
              numericInput(inputId = "threshold",
                           label = "阈值",
                           value = 50,
                           min = 1,
                           max = 100)),
      tabItem(tabName = "hist",
              plotOutput(outputId = "distPlot"))
    )
  )
)

server <- function(input, output) {
  output$distPlot <- renderPlot({
    x <- if(input$data_type == "等待时间") faithful$waiting else faithful$eruptions
    bins <- seq(min(x), max(x), length.out = input$bins + 1)
    
    hist(x, breaks = bins, col = "#75AADB", border = "white",
         xlab = if(input$data_type == "等待时间") "等待时间（分钟）" else "喷发时长（分钟）",
         main = "间歇泉数据直方图")
  })
}

shinyApp(ui = ui, server = server)

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