使用bslib Bootswatch 5主题时Shiny的conditionalPanel失效原因

问题描述 #

开发R Shiny应用时，期望侧边栏内容能随tabsetPanel的选中项切换。该功能在原生Shiny中正常，但使用bslib的Bootswatch 4/5主题时异常：带有textInput(id='textInput2')的conditionalPanel无法显示，切换回Bootswatch 3则恢复正常。推测是JavaScript或命名空间冲突导致，已尝试重新安装shiny和bslib，问题未解决。

最小复现代码 #

library(shiny)
library(bslib)

options(shiny.port = 8080)

# UI/Server for Module_1
module_1_ui <- function(id) {
  ns <- NS(id)
  tabPanel("Main", fluid = TRUE,
      sidebarLayout(
        sidebarPanel(
          textInput(ns('textInput'), 'Enter text')
        ),
        mainPanel(
          uiOutput(ns('textOutput'))
        )
      )
  )
  
}

module_1_server <- function(id, session) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns

    output$textOutput <- renderUI({
      req(input$textInput)
      HTML(paste0('You entered: ', input$textInput))
    })
    
  })

}
# UI/Server for Module_2
module_2_ui <- function(id) {
  ns <- NS(id)

  tabPanel("Side", fluid = TRUE,
      sidebarLayout(
        sidebarPanel(
          HTML("This always shows!"),
          br(),
          conditionalPanel(
            condition =  sprintf("input['%s'] == 'Test2'", ns("side_tabsets")),
            textInput(ns('textInput2'), 'Enter text')
          )
        ),
        mainPanel(
          uiOutput(ns('sideOutput'))
        )
      )
  )
}

module_2_server <- function(id, session) {

  moduleServer(id, function(input, output, session) {
    ns <- session$ns

    output$sideOutput <- renderUI({
      tabsetPanel(
        id = ns("side_tabsets"),
        tabPanel(title = "Test1", br(), actionButton(ns("button1"), "Button 1")),
        tabPanel(title = "Test2", br(), actionButton(ns("button2"), "Button 2"))
      )
    })
  })
}

# Overall UI
ui <- fluidPage(
  theme = bs_theme(bootswatch = "cosmo", version = 5),
  navbarPage(title = "",
    module_1_ui("main"),
    module_2_ui("side")
  )
)

# Overall Server
server <- function(input, output, session) {
  module_1_server("main", session)
  module_2_server("side", session)
}

shinyApp(ui = ui, server = server)

Session信息 #

> sessionInfo()
R version 4.3.3 (2024-02-29)
Platform: x86_64-apple-darwin20 (64-bit)
Running under: macOS Sonoma 14.3.1

Matrix products: default
BLAS:   /Library/Frameworks/R.framework/Versions/4.3-x86_64/Resources/lib/libRblas.0.dylib 
LAPACK: /Library/Frameworks/R.framework/Versions/4.3-x86_64/Resources/lib/libRlapack.dylib;  LAPACK version 3.11.0

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

time zone: America/Los_Angeles
tzcode source: internal

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] bslib_0.8.0   shiny_1.8.1.1

loaded via a namespace (and not attached):
 [1] digest_0.6.36     later_1.3.2       R6_2.5.1          httpuv_1.6.15    
 [5] fastmap_1.2.0     magrittr_2.0.3    cachem_1.1.0      htmltools_0.5.8.1
 [9] lifecycle_1.0.4   promises_1.3.0    cli_3.6.3         xtable_1.8-4     
[13] sass_0.4.9        jquerylib_0.1.4   compiler_4.3.3    tools_4.3.3      
[17] mime_0.12         Rcpp_1.0.13       jsonlite_1.8.8    rlang_1.1.4     

解决方案 #

问题根源 #

Bootstrap 4及以上版本中，Shiny的tabsetPanel组件逻辑发生变化：input$<tabset_id>返回的不再是tab的标题文本，而是tab的value属性值。若未显式指定value，Shiny会自动生成随机ID而非使用标题，导致原conditionalPanel中的条件判断（匹配标题"Test2"）无法触发。

修复步骤 #

给tabsetPanel内的每个tabPanel显式添加value参数，确保参数值与conditionalPanel的判断值一致。

修改后的完整代码 #

library(shiny)
library(bslib)

options(shiny.port = 8080)

# UI/Server for Module_1
module_1_ui <- function(id) {
  ns <- NS(id)
  tabPanel("Main", fluid = TRUE,
      sidebarLayout(
        sidebarPanel(
          textInput(ns('textInput'), 'Enter text')
        ),
        mainPanel(
          uiOutput(ns('textOutput'))
        )
      )
  )
  
}

module_1_server <- function(id, session) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns

    output$textOutput <- renderUI({
      req(input$textInput)
      HTML(paste0('You entered: ', input$textInput))
    })
    
  })

}
# UI/Server for Module_2
module_2_ui <- function(id) {
  ns <- NS(id)

  tabPanel("Side", fluid = TRUE,
      sidebarLayout(
        sidebarPanel(
          HTML("This always shows!"),
          br(),
          conditionalPanel(
            condition =  sprintf("input['%s'] == 'Test2'", ns("side_tabsets")),
            textInput(ns('textInput2'), 'Enter text')
          )
        ),
        mainPanel(
          uiOutput(ns('sideOutput'))
        )
      )
  )
}

module_2_server <- function(id, session) {

  moduleServer(id, function(input, output, session) {
    ns <- session$ns

    output$sideOutput <- renderUI({
      tabsetPanel(
        id = ns("side_tabsets"),
        # 显式指定value参数，与条件判断值一致
        tabPanel(title = "Test1", value = "Test1", br(), actionButton(ns("button1"), "Button 1")),
        tabPanel(title = "Test2", value = "Test2", br(), actionButton(ns("button2"), "Button 2"))
      )
    })
  })
}

# Overall UI
ui <- fluidPage(
  theme = bs_theme(bootswatch = "cosmo", version = 5),
  navbarPage(title = "",
    module_1_ui("main"),
    module_2_ui("side")
  )
)

# Overall Server
server <- function(input, output, session) {
  module_1_server("main", session)
  module_2_server("side", session)
}

shinyApp(ui = ui, server = server)

验证说明 #

修改后切换到"Side"标签页下的"Test2"子tab时，侧边栏的textInput2会正常显示，Bootswatch 5主题下功能恢复正常。

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