bslib侧边栏与shinyWidgets的pickerInput兼容问题求助

问题描述 #

我现在遇到一个棘手的问题：我有个规模不小的Shiny应用，用了bslib的sidebar功能来布局，同时想用上shinyWidgets里pickerInput的特性，但这俩组件放一起就出冲突——要么侧边栏直接不显示，要么pickerInput的选项加载不出来，连带表格也一直是空的。

我写了个最小复现案例，现在的情况是：

• 保留page_sidebar和sidebar的话，UI布局看起来是对的，但下拉框完全是空的，表格也没有数据输出
• 去掉page_sidebar之后，pickerInput和表格都能正常工作，但就没了侧边栏（实际应用里侧边栏有用户必须的信息，不能丢）
• 试过把pickerInput的choices换成固定数组比如c("A", "B", "C")，还是没用

有没有大佬能指点下怎么解决这个兼容问题？

附上复现代码：

library(tidyverse)
library(shiny)
library(bslib)

met_data <- data.frame(
  STATE = rep(c("Alabama", "Arkansas", "Maine", "Minnesota", "Texas"), 4),
  MET_VAR = rep(c('degC', 'rain', 'ice', 'humidity'), 5),
  RESULT = rnorm(20)
)

ui <- fluidPage( # open fluidPage
  
  page_sidebar( # open page_sidebar
  
  sidebar = sidebar( # open sidebar

    style = "position:fixed",
    bg = "#C8CBD2",
    width = 350,
    h3("Example sidebar")

  ), # close sidebar
  
  mainPanel( # open mainPanel
    
    width = 1400,
    
    # Input: choose state(s)
    shinyWidgets::pickerInput(
      inputId = 'stateInput',
      label = "Select State",
      choices = sort(unique(met_data$STATE)),
      options = list(`actions-box` = TRUE),
      multiple = TRUE
    ),
    
    # Input: choose met variable(s)
    shinyWidgets::pickerInput(
      inputId = 'Met_variable',
      label = "Select Variable",
      choices = sort(unique(met_data$MET_VAR)),
      options = list(`actions-box` = TRUE),
      multiple = TRUE
    ),
    
    # DX US met data --------------------------------------------------------
    DT::dataTableOutput("report_table")
    
  ), # close mainPanel
  
  ) # close page_sidebar
  
) # close fluidPage


server <- function(input, output, session) {
  
  report_data <- reactive({
    
    met_data %>% 
      filter(
        STATE %in% input$stateInput &
          MET_VAR %in% input$Met_variable
      ) %>% 
      arrange(.$STATE) %>%
      mutate(
        STATE = factor(STATE),
        MET_VAR = factor(MET_VAR)
      )
    
  })
  
  output$report_table <- DT::renderDataTable({
    
    report_data() %>%
      DT::datatable(
        {},
        escape = FALSE,
        filter = "top",
        options = list(
          scrollX = TRUE,
          autowidth = TRUE
        )
      )
    
  })
  
}

shinyApp(ui = ui, server = server)

解决方案 #

这个问题主要是bslib布局组件的嵌套规范和依赖加载两个核心问题导致的，我帮你整理了修复后的代码，同时优化了一些容易踩坑的小细节：

核心问题分析

1. 错误的UI嵌套：你用fluidPage包裹了page_sidebar，但page_sidebar本身就是bslib提供的完整页面布局组件，不需要再嵌套在fluidPage里，这种嵌套会触发前端JS渲染冲突，导致pickerInput的选项无法正常初始化。
2. 缺失的依赖注册：你用了shinyWidgets::pickerInput但没有显式加载shinyWidgets包，虽然命名空间调用能找到函数，但pickerInput的前端JS/CSS资源需要包加载时才能注册到Shiny应用中，这也是选项不显示的关键原因之一。
3. Server端的小语法问题：比如arrange(.$STATE)可以简化为arrange(STATE)，还有DT::datatable({},里多余的{}会导致表格无法正确接收数据。

修复后的完整代码

library(tidyverse)
library(shiny)
library(bslib)
library(shinyWidgets) # 必须显式加载，注册前端依赖

met_data <- data.frame(
  STATE = rep(c("Alabama", "Arkansas", "Maine", "Minnesota", "Texas"), 4),
  MET_VAR = rep(c('degC', 'rain', 'ice', 'humidity'), 5),
  RESULT = rnorm(20)
)

# 移除fluidPage嵌套，直接用page_sidebar作为顶层UI组件
ui <- page_sidebar( 
  sidebar = sidebar( 
    style = "position:fixed",
    bg = "#C8CBD2",
    width = 350,
    h3("Example sidebar")
  ), 
  mainPanel( 
    width = 1400,
    # 现在可以直接用pickerInput，不用加命名空间
    pickerInput(
      inputId = 'stateInput',
      label = "Select State",
      choices = sort(unique(met_data$STATE)),
      options = list(`actions-box` = TRUE),
      multiple = TRUE,
      selected = sort(unique(met_data$STATE)) # 可选：默认选中所有选项，方便测试
    ),
    
    pickerInput(
      inputId = 'Met_variable',
      label = "Select Variable",
      choices = sort(unique(met_data$MET_VAR)),
      options = list(`actions-box` = TRUE),
      multiple = TRUE,
      selected = sort(unique(met_data$MET_VAR)) # 可选：默认选中所有选项
    ),
    
    DT::dataTableOutput("report_table")
  )
)

server <- function(input, output, session) {
  
  report_data <- reactive({
    # 确保输入有效后再计算，避免空值错误
    req(input$stateInput, input$Met_variable)
    
    met_data %>% 
      filter(
        STATE %in% input$stateInput &
          MET_VAR %in% input$Met_variable
      ) %>% 
      arrange(STATE) %>% # 简化写法，直接用列名
      mutate(
        STATE = factor(STATE),
        MET_VAR = factor(MET_VAR)
      )
  })
  
  output$report_table <- DT::renderDataTable({
    report_data() %>% # 修复管道和多余的{}
      DT::datatable(
        escape = FALSE,
        filter = "top",
        options = list(
          scrollX = TRUE,
          autowidth = TRUE
        )
      )
  })
}

shinyApp(ui = ui, server = server)

修复效果验证

运行这个修改后的代码，你会发现：

• 侧边栏正常显示，样式和你设置的完全一致
• pickerInput的选项会正确加载出来，默认选中所有选项（你可以去掉selected参数改成默认空）
• 选择不同的选项，表格会实时过滤并显示对应的数据

备注：内容来源于stack exchange，提问作者user3900349