如何在Shiny复杂模块中正确显示默认值

我编写的代码用于实现多个多选输入框间选项互斥（即一个输入框选中的选项不会出现在其他输入框的可选列表中），但在Shiny模块结构下，预设的默认值无法正确显示。原代码如下：

# 定义letter模块的UI
letterUI <- function(id, input_id, default_value = NULL) {
  selectizeInput(NS(id, input_id), label = "评级", choices = NULL, 
                 multiple = TRUE, selected = default_value)
}

letterServer <- function(id, modalities, default_values) {
  moduleServer(id, function(input, output, session) {

    observe({
      updateSelectizeInput(session, "letters_1", choices = modalities, 
                           selected = default_values$letters_1)
      updateSelectizeInput(session, "letters_2", choices = modalities, 
                           selected = default_values$letters_2)
      updateSelectizeInput(session, "letters_3", choices = modalities, 
                           selected = default_values$letters_3)
    })
    
    observeEvent({
      input$letters_2
      input$letters_3
    }, {
      updateSelectizeInput(session, "letters_1", choices = modalities[!modalities %in% c(input$letters_2, input$letters_3)], 
                           selected = input$letters_1)
    }, ignoreNULL = FALSE)
    
    observeEvent({
      input$letters_1
      input$letters_3
    }, {
      updateSelectizeInput(session, "letters_2", choices = modalities[!modalities %in% c(input$letters_1, input$letters_3)], 
                           selected = input$letters_2)
    }, ignoreNULL = FALSE)
    
    observeEvent({
      input$letters_2
      input$letters_1
    }, {
      updateSelectizeInput(session, "letters_3", choices = modalities[!modalities %in% c(input$letters_2, input$letters_1)], 
                           selected = input$letters_3)
    }, ignoreNULL = FALSE)

    onRestore(function(state) {
      observeEvent(reactiveVal(TRUE), {
        updateSelectizeInput(session, "letters_1", selected = state$input$letters_1)
        updateSelectizeInput(session, "letters_2", selected = state$input$letters_2)
        updateSelectizeInput(session, "letters_3", selected = state$input$letters_3)
      })
    })

    letters_1 <- reactive(input$letters_1)
    letters_2 <- reactive(input$letters_2)
    letters_3 <- reactive(input$letters_3)

    return_list <- list(
      letters_1 = letters_1,
      letters_2 = letters_2,
      letters_3 = letters_3
    )

    return(return_list)
  })
}

# Shiny应用UI
ui <- fluidPage(
  letterUI("letters", "letters_1", default_value = "A"),
  letterUI("letters", "letters_2", default_value = c("B", "C")),
  letterUI("letters", "letters_3", default_value = 'D')
)

# Shiny应用Server
server <- function(input, output, session) {
  modalities <- LETTERS[1:10]
  letters_chosen <- letterServer('letters',modalities = modalities,default_values = list(letters_1 = 'A',
  letters_2 = 'B',letters_3 = 'C'))
}

shinyApp(ui = ui, server = server)

问题根源 #

• 初始的observe无触发限制，反复执行后与后续互斥逻辑的observeEvent冲突，导致默认值被覆盖
• Server端传入的默认值与UI端不一致（UI中letters_2默认是c("B","C")，但Server中传的是"B"）
• 互斥逻辑更新选项时，未检查当前选中值是否在可选列表内，可能导致选中值被清空
• onRestore写法冗余，没必要用reactiveVal(TRUE)触发更新

修复后的代码 #

# 定义letter模块的UI
letterUI <- function(id, input_id, default_value = NULL) {
  selectizeInput(NS(id, input_id), label = "评级", choices = NULL, 
                 multiple = TRUE, selected = default_value)
}

letterServer <- function(id, modalities, default_values) {
  moduleServer(id, function(input, output, session) {
    # 模块初始化时仅执行一次，设置符合互斥规则的初始选项与默认值
    observe({
      # 给letters_1设置可选列表（排除2、3的默认值）
      used_vals <- c(default_values$letters_2, default_values$letters_3)
      updateSelectizeInput(session, "letters_1", 
                           choices = modalities[!modalities %in% used_vals],
                           selected = default_values$letters_1)
      
      # 给letters_2设置可选列表（排除1、3的默认值）
      used_vals <- c(default_values$letters_1, default_values$letters_3)
      updateSelectizeInput(session, "letters_2", 
                           choices = modalities[!modalities %in% used_vals],
                           selected = default_values$letters_2)
      
      # 给letters_3设置可选列表（排除1、2的默认值）
      used_vals <- c(default_values$letters_1, default_values$letters_2)
      updateSelectizeInput(session, "letters_3", 
                           choices = modalities[!modalities %in% used_vals],
                           selected = default_values$letters_3)
    }, once = TRUE) # 关键：仅执行一次
    
    # 更新letters_1的可选列表（排除2、3的当前选中值）
    observeEvent({
      input$letters_2
      input$letters_3
    }, {
      available <- modalities[!modalities %in% c(input$letters_2, input$letters_3)]
      # 确保选中值在可选范围内，避免被清空
      selected <- intersect(input$letters_1, available)
      updateSelectizeInput(session, "letters_1", 
                           choices = available, 
                           selected = selected)
    }, ignoreNULL = FALSE)
    
    # 更新letters_2的可选列表（排除1、3的当前选中值）
    observeEvent({
      input$letters_1
      input$letters_3
    }, {
      available <- modalities[!modalities %in% c(input$letters_1, input$letters_3)]
      selected <- intersect(input$letters_2, available)
      updateSelectizeInput(session, "letters_2", 
                           choices = available, 
                           selected = selected)
    }, ignoreNULL = FALSE)
    
    # 更新letters_3的可选列表（排除1、2的当前选中值）
    observeEvent({
      input$letters_1
      input$letters_2
    }, {
      available <- modalities[!modalities %in% c(input$letters_1, input$letters_2)]
      selected <- intersect(input$letters_3, available)
      updateSelectizeInput(session, "letters_3", 
                           choices = available, 
                           selected = selected)
    }, ignoreNULL = FALSE)

    # 简化状态恢复逻辑
    onRestore(function(state) {
      updateSelectizeInput(session, "letters_1", selected = state$input$letters_1)
      updateSelectizeInput(session, "letters_2", selected = state$input$letters_2)
      updateSelectizeInput(session, "letters_3", selected = state$input$letters_3)
    })

    # 返回选中值的响应式对象
    list(
      letters_1 = reactive(input$letters_1),
      letters_2 = reactive(input$letters_2),
      letters_3 = reactive(input$letters_3)
    )
  })
}

# Shiny应用UI
ui <- fluidPage(
  letterUI("letters", "letters_1", default_value = "A"),
  letterUI("letters", "letters_2", default_value = c("B", "C")),
  letterUI("letters", "letters_3", default_value = 'D')
)

# Shiny应用Server
server <- function(input, output, session) {
  modalities <- LETTERS[1:10]
  # 统一UI与Server端的默认值
  letters_chosen <- letterServer('letters',
                                 modalities = modalities,
                                 default_values = list(letters_1 = 'A',
                                                      letters_2 = c("B","C"),
                                                      letters_3 = 'D'))
}

shinyApp(ui = ui, server = server)

关键修改点 #

1. 初始设置的observe添加once = TRUE，避免重复执行覆盖后续逻辑
2. 初始化时直接应用互斥规则，确保默认值对应的输入框可选列表已排除其他输入框的默认值
3. 互斥逻辑中用intersect确保选中值始终在可选范围内，防止选中值被清空
4. 统一UI与Server端的默认值，消除不一致问题
5. 简化onRestore逻辑，直接更新选中值即可

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