R Shiny模块中SelectInput切换数据集不更新问题

切换数据集不刷新是响应式链路断裂导致的，具体错误点如下：

• 模块传参时错误传入响应式对象的瞬时值：调用LoadDataServer时传入pnl1()（加括号会立即执行取值），而非响应式对象本身pnl1，后续选择项变化时模块内部无法感知更新。
• 响应式对象赋值逻辑错误：在LoadDataServer中直接给reactiveValues的字段赋值reactive对象，无法建立正确的依赖触发关系。
• 绘图模块传参同样丢失响应式：调用PlotServer时传入d1$norm()/d1$pois()的瞬时值，数据更新时绘图函数不会重新执行。
• 存在无效冗余逻辑：主server中写了未做命名空间处理的updateSelectInput监听，既找不到对应组件也无实际作用；重复给output$plot赋值会导致后一个绘图覆盖前一个输出。

# Libraries
pacman::p_load(shiny, shinydashboard,
               tidyverse, data.table, DT, stringr,
               ggplot2, plotly,
               survival, survminer, GGally, scales,
               shinycssloaders)

version <- 0.1

# GENERAL PARAMETERS
box.height <<- 700
select.box.height <<- 150
selectAB.box.height <<- 250
select.box.width <<- 12

# Data
men1_1.norm <<- as.numeric(rnorm(50))
men1_1.pois <<- as.numeric(rpois(50, lambda = 1))
men1_2.norm <<- as.numeric(rnorm(50, mean = 1))
men1_2.pois <<- as.numeric(rpois(50, lambda = 2))

# ui modules
LoadDataUI <- function(id, 
                       label = "Select the data:", 
                       sel = "Data 1", 
                       choic = c('Data 1','Data 2')){
  ns <- NS(id)
  selectInput(ns("data.sel"),
              label = label,
              choices = choic,
              selected = sel)
}

PlotUI <- function(id){
  ns <- NS(id)
  plotOutput(ns("plot"))
}

# ui
ui <- dashboardPage(
  dashboardHeader(title = paste('My Dashboard',version,sep='')),
  dashboardSidebar(
    sidebarMenu(
      id = "sbMenu",
      menuItem("1st Menu", tabName = "men1", icon = icon('microscope'))
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = 'men1',
              h2(strong('tab 1')),
              fluidRow(
                box(title='Select data to load:', height= select.box.height, width = select.box.width,
                    LoadDataUI("data1")
                ),
                box(title='Normal', height=box.height,
                    PlotUI("hist_norm1")
                ),
                box(title='Poisson', height=box.height,
                    PlotUI("hist_pois1")
                )
              )
      )
    )
  )
)


# server modules
Panel <- function(id){
  moduleServer(
    id,
    function(input, output, session) {
      return(
        list(
          data = reactive({input$data.sel})
        )
      )
    }
  )
}

LoadDataServer <- function(id, menu, data_selected){
  moduleServer(
    id,
    function(input, output, session){
      # 直接返回响应式列表，不需要套reactiveValues赋值reactive
      data <- list(
        norm = reactive({
          # 传入的是响应式对象，取值时加括号
          get(paste0(menu(),"_", data_selected(), ".norm"), envir = .GlobalEnv)
        }),
        pois = reactive({
          get(paste0(menu(),"_", data_selected(), ".pois"), envir = .GlobalEnv)
        })
      )
      return(data)
    }
  )
}


PlotServer <- function(id,data = NULL){
  moduleServer(
    id,
    function(input, output, session) {
      output$plot <- renderPlot({
        # 传入的是响应式对象，取值时加括号
        hist(data(), col = 'darkgray', border = 'white')
      })
    }
  )
}


# server
server <- function(input, output, session){
  data1 <- Panel("data1")
  # 删除无效的updateSelectInput逻辑
  pnl1 <- reactive(
    switch(data1$data(),
           "Data 1" = "1",
           "Data 2" = "2")
  )
  # 传响应式对象本身，不要加括号取瞬时值
  d1 <- LoadDataServer("data1", menu = reactive({input$sbMenu}), data_selected = pnl1)

  # 直接调用绘图模块，不需要赋值给output$plot，传响应式对象本身
  PlotServer("hist_norm1", data = d1$norm)
  PlotServer("hist_pois1", data = d1$pois)
}

shinyApp(ui, server)

• 所有跨模块传递响应式值时，直接传递响应式对象（不加括号），仅在模块内部需要取值计算时才加括号触发依赖。
• 不要给reactiveValues的字段直接赋值reactive对象，要么在observe事件内给reactiveValues赋静态计算值，要么直接返回包含reactive的列表。
• 模块内部的output会自动绑定对应命名空间的UI输出，不需要在主server中重复赋值给全局output对象。

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