为什么使用 bslib bootswatch 主题版本 5 时条件面板无法工作？

Question

我正在尝试创建一个简单的应用程序，其中侧边栏将根据用户当前选择的 tabsetPanel 进行更改。它本身可以与 R Shiny 配合使用，但是当我尝试使用 bslib 对其进行样式设置时，它开始崩溃。我怀疑这是一些 Javascript 或 NS 冲突的结果。

此外，只有当我使用 Bootswatch 主题版本 4 或 5 时，它才会中断。我在下面提供了一个最小的例子。

为什么带有textInput

id = "textInput2"

的conditionalPanel不显示？如果你把bootswatch的版本改回版本3，就可以了。

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)

这是我的会话信息：

> 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     

我尝试重新下载shiny和bslib，看看是否是软件包安装的问题。

Answer 1

bslib

有自己的

page_*

函数来生成页面布局，应该使用shiny的

*Page

函数来支持。将

fluidPage()

和

navbarPage()

替换为

page_fluid()

和

page_navbar()

就可以了。

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 <- page_fluid(
  theme = bs_theme(bootswatch = "cosmo", version = 5),
  page_navbar(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)