如何在bslib的nav_menu/nav_panel中复用Shiny模块？

核心思路 #

只实例化一个subj_ui()和subj_srv()模块，让模块逻辑依赖于当前选中的响应式主题，而非为每个主题单独创建模块实例，完美适配你20+主题的场景。

1. UI 部分实现 #

用bslib的导航组件批量生成主题选择项，内容区只放一次模块UI：

library(shiny)
library(bslib)
library(purrr)

# 你的20个主题列表
themes <- c("主题A", "主题B", "主题C", "主题D", ...)

ui <- page_sidebar(
  sidebar = sidebar(
    nav_menu(
      id = "theme_selector", # 用于监听选中的主题
      title = "选择主题",
      # 批量生成所有主题面板
      !!!map(themes, ~nav_panel(title = .x))
    )
  ),
  # 仅实例化一次模块UI
  subj_ui("shared_subj_module")
)

2. 服务器端实现 #

监听导航选中项，将其转为响应式值传入模块，模块内部根据主题动态执行查询和渲染：

# 先修改模块，让它接收响应式主题参数
subj_ui <- function(id) {
  ns <- NS(id)
  card(
    h3(textOutput(ns("theme_name"))),
    tableOutput(ns("theme_data_table")) # 示例：展示主题相关数据
  )
}

subj_srv <- function(id, selected_theme) {
  moduleServer(id, function(input, output, session) {
    # 根据选中主题动态查询数据库
    theme_data <- reactive({
      req(selected_theme()) # 确保主题已选中
      # 替换成你的实际数据库查询逻辑，用selected_theme()作为筛选条件
      dbGetQuery(
        your_db_connection,
        sprintf("SELECT * FROM theme_info WHERE theme = '%s'", selected_theme())
      )
    })
    
    # 渲染主题标题
    output$theme_name <- renderText({
      paste("当前主题：", selected_theme())
    })
    
    # 渲染主题数据表格
    output$theme_data_table <- renderTable({
      theme_data()
    })
  })
}

server <- function(input, output, session) {
  # 响应式变量：当前选中的主题
  current_selected_theme <- reactive(input$theme_selector)
  
  # 仅实例化一次模块，传入响应式主题
  subj_srv("shared_subj_module", current_selected_theme)
}

shinyApp(ui, server)

3. 关键细节说明 #

• 和你之前shinydashboard的逻辑完全对齐：通过input$theme_selector监听选中的主题，用响应式值驱动模块内容更新，无需手动调用updateTabItems。
• 性能优化：只有一个模块实例，数据库查询仅在主题切换时触发，避免20个模块同时初始化的资源浪费。
• 额外优化：如果主题数据不频繁更新，可使用reactiveCache缓存查询结果，减少重复数据库请求：

# 在subj_srv中替换theme_data的定义
theme_data <- reactiveCache(
  function(theme) {
    dbGetQuery(your_db_connection, sprintf("SELECT * FROM theme_info WHERE theme = '%s'", theme))
  },
  cache_key = selected_theme()
)

内容的提问来源于stack exchange，提问作者Karsten W.