R Shiny的 bslib侧边栏与shinyWidgets的 pickerInput不兼容

编程语言 2026-07-12

我有一个相当大型的Shiny应用，它使用来自 bslib 的 sidebar 功能，并让用户通过选择输入值来生成一个表格。我需要使用来自 shinyWidgets 的 pickerInput 的某些功能，但把它们一起使用时要么 sidebar 要么 pickerInput 会失败。对于 sidebar 失败的情况，侧边栏不会出现；对于 pickerInput 失败的情况，选项不会填充。

以下的最小示例可以重现该错误。

按原样运行时看起来是期望的外观，但下拉框以及由此产生的表格仍然是空的。

去掉 page_sidebar 时，不论是保留 sidebar 还是同时移除 sidebar，在用户界面和表格输出方面都达到期望的效果，但没有侧边栏。在这个示例中，侧边栏是空的，但在实际应用中，侧边栏包含对用户来说必需的信息。

将选项替换为固定数组（例如 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)

解决方案

请使用 page_sidebar 代替 fluidPage——它们是互斥的；请参阅示例。

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 <- page_sidebar( # replace page_fluid

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

  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
    ),

    DT::dataTableOutput("report_table")

  )
) 


server <- function(input, output, session) {
  report_data <- reactive({
    req(input$stateInput, input$Met_variable) # require inputs before using them
    met_data |>
      subset(STATE %in% input$stateInput &
               MET_VAR %in% input$Met_variable) |>
      sort_by( ~ STATE) |>
      transform(STATE = factor(STATE), MET_VAR = factor(MET_VAR))

  })  
  output$report_table <- DT::renderDataTable({
    DT::datatable(
      report_data(),
      escape = FALSE,
      filter = "top",
      options = list(scrollX = TRUE, autowidth = TRUE)
    )

  })

}

shinyApp(ui = ui, server = server)