R Shiny模块化应用：仅首次切换至Tab1时弹出数据集选择模态框

我有一个模块化R Shiny应用，需要实现两个核心逻辑：

• 仅当用户切换到「Tab 1」标签页时，显示数据集选择模态框
• 模态框仅在首次点击进入Tab 1时弹出一次

目前不清楚如何获取当前激活的标签页状态，也不知道怎么实现首次触发的计数器逻辑，现有代码如下：

现有代码 #

模块1 #

library(shiny)
library(shinyjs)
library(shinyWidgets)

# 模块1 UI
module1_ui <- function(id) {
  ns <- NS(id)
  
  tabPanel(
    title = "Home",
    shiny::tags$p(
      "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua."
    )
  )
}

# 模块1 服务器
module1_server <- function(id, r_global) {
  moduleServer(id, function(input, output, session) {})
}

模块2 #

# 模块2 UI
module2_ui <- function(id) {
  ns <- NS(id)
  
  tabPanel(
    title = "Tab 1",
    useShinyjs(),
    actionLink(
      inputId = ns("display_modal"),
      label = "选择数据集",
      style = "position: relative; left:90%"
    ),
    tableOutput(outputId = ns("myTable"))
  )
}

# 模块2 服务器
module2_server <- function(id, r_global) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    
    # 模态框定义
    dataModal <- function(failed = FALSE) {
      modalDialog(
        shiny::tags$h3("选择数据集："),
        panel(
          shinyWidgets::pickerInput(
            inputId = ns("dataset_select"),
            label = "数据集：",
            choices = c("dt1" = "dt1", "dt2" = "dt2"),
            multiple = FALSE,
            options = list(`actions-box` = TRUE)
          )
        ),
        footer = tagList(
          modalButton(label = "取消"),
          actionButton(inputId = ns("ok"), label = "确定")
        )
      )
    }
    
    # 原代码直接显示模态框（需要修改）
    # showModal(dataModal())
    
    # 点击确定按钮的逻辑
    observeEvent(input$ok, {
      removeModal()
      
      output$myTable <- renderTable({
        if(input$dataset_select == "dt1"){
          iris
        }else{
          mtcars
        }
      })
    })
    
    # 点击链接显示模态框的逻辑
    observeEvent(input$display_modal, {
      showModal(dataModal())
    })
  })
}

主UI与主服务器 #

# 主UI
app_ui <- function(request) {
  tagList(
    navbarPage(id = "main_menu", "我的应用", 
               module1_ui("mod1"),
               module2_ui("mod2")
    )
  )
}

# 主服务器
app_server <- function(input, output, session) {
  
  r_global <- reactiveValues(data = NULL)
  
  module1_server(id = "mod1", r_global = r_global)
  module2_server(id = "mod2", r_global = r_global)
}

shinyApp(ui = app_ui, server = app_server)

解决方案 #

核心逻辑说明 #

1. 获取当前标签页：利用navbarPage的id（main_menu），通过input$main_menu实时获取当前激活的标签页，将状态存入全局reactiveValues供模块调用。
2. 首次触发计数器：在全局reactiveValues中添加一个计数器，记录「Tab 1」被访问的次数，仅当计数器为0时（首次进入）弹出模态框，弹出后将计数器置为1。

修改后的完整代码 #

library(shiny)
library(shinyjs)
library(shinyWidgets)

# 模块1 UI
module1_ui <- function(id) {
  ns <- NS(id)
  
  tabPanel(
    title = "Home",
    shiny::tags$p(
      "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua."
    )
  )
}

# 模块1 服务器
module1_server <- function(id, r_global) {
  moduleServer(id, function(input, output, session) {})
}

# 模块2 UI
module2_ui <- function(id) {
  ns <- NS(id)
  
  tabPanel(
    title = "Tab 1",
    useShinyjs(),
    actionLink(
      inputId = ns("display_modal"),
      label = "选择数据集",
      style = "position: relative; left:90%"
    ),
    tableOutput(outputId = ns("myTable"))
  )
}

# 模块2 服务器
module2_server <- function(id, r_global) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    
    # 模态框定义
    dataModal <- function(failed = FALSE) {
      modalDialog(
        shiny::tags$h3("选择数据集："),
        panel(
          shinyWidgets::pickerInput(
            inputId = ns("dataset_select"),
            label = "数据集：",
            choices = c("dt1" = "dt1", "dt2" = "dt2"),
            multiple = FALSE,
            options = list(`actions-box` = TRUE)
          )
        ),
        footer = tagList(
          modalButton(label = "取消"),
          actionButton(inputId = ns("ok"), label = "确定")
        )
      )
    }
    
    # 监听当前标签页状态，实现首次进入Tab1弹出模态框
    observeEvent(r_global$active_tab, {
      if(r_global$active_tab == "Tab 1" && r_global$tab1_visit_count == 0) {
        showModal(dataModal())
        # 标记为已访问，避免重复弹出
        r_global$tab1_visit_count <- 1
      }
    })
    
    # 点击确定按钮的逻辑
    observeEvent(input$ok, {
      removeModal()
      
      output$myTable <- renderTable({
        if(input$dataset_select == "dt1"){
          iris
        }else{
          mtcars
        }
      })
    })
    
    # 点击链接显示模态框的逻辑
    observeEvent(input$display_modal, {
      showModal(dataModal())
    })
  })
}

# 主UI
app_ui <- function(request) {
  tagList(
    navbarPage(id = "main_menu", "我的应用", 
               module1_ui("mod1"),
               module2_ui("mod2")
    )
  )
}

# 主服务器
app_server <- function(input, output, session) {
  
  r_global <- reactiveValues(
    data = NULL,
    active_tab = NULL,
    tab1_visit_count = 0 # 新增：Tab1访问计数器，初始为0
  )
  
  # 实时同步当前激活的标签页
  observe({
    r_global$active_tab <- input$main_menu
  })
  
  module1_server(id = "mod1", r_global = r_global)
  module2_server(id = "mod2", r_global = r_global)
}

shinyApp(ui = app_ui, server = app_server)

修改点说明 #

1. 主服务器：

   • 在r_global中新增active_tab（存储当前标签页）和tab1_visit_count（访问计数器，初始为0）
   • 添加observe监听input$main_menu，实时更新r_global$active_tab

2. 模块2服务器：

   • 移除原代码中直接调用的showModal(dataModal())
   • 添加observeEvent监听r_global$active_tab，当标签页为「Tab 1」且计数器为0时，弹出模态框并将计数器置为1

这样就实现了仅首次进入「Tab 1」时弹出模态框的需求，同时保留了手动点击链接重新打开模态框的功能。

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