如何让MutationObserver仅监听特定pickerInput组件？

问题背景 #

原方案在单个pickerInput组件中可正常实现点击分组标题全选/取消该组选项，但同一应用存在多个pickerInput时出现异常：

• 点击第一个组件的分组标题，会错误更新第二个组件的选中项
• 点击第二个组件的分组标题无响应
• 当组件位于shinydashboard不同标签页时，原代码中的MutationObserver完全失效；尝试用req(input$sidebar == "tab_name")优化后，第二个组件仅能在点击第一个组件分组后工作一次

原问题复现代码 #

library(shiny)
library(shinyWidgets)

js <- HTML("
$(function() {
  let observer = new MutationObserver(callback);

  function clickHandler(evt) {
    Shiny.setInputValue('group_select', $(this).children('span').text(),{priority: \"event\"});
  }

  function callback(mutations) {
    for (let mutation of mutations) {
      if (mutation.type === 'childList') {
        $('.dropdown-header').on('click', clickHandler).css('cursor', 'pointer');
        
      }
    }
  }

  let options = {
    childList: true,
  };

  observer.observe($('.inner')[0], options);
})
")

choices <- list("A" = c(1, 2, 3, 4, 5), "B" = c(6, 7, 8, 9, 10), "C" = c(11,12,13,14,15))

ui <- fluidPage(
    tags$head(tags$script(js)),
    pickerInput("test", choices = choices, multiple = TRUE,options = list('actions-box' = TRUE)),
    textOutput("testOutput"),
    pickerInput("test_2", choices = choices, multiple = TRUE,options = list('actions-box' = TRUE)),
    textOutput("testOutput_2")
)

server <- function(input, output, session) {
    output$testOutput <- renderText({paste(input$test)})
    output$testOutput_2 <- renderText({paste(input$test_2)})
    
    observeEvent(input$group_select, {
        req(input$group_select)
        if(all(choices[[input$group_select]] %in% input$test_2)){
            sel <- input$test_2[!(input$test_2 %in% choices[[input$group_select]])]
        }else{
            sel <- union(input$test_2, choices[[input$group_select]])
        }
        updatePickerInput(session, "test_2", selected = sel)
    }) 
}

shinyApp(ui = ui, server = server)

问题根源 #

原代码核心问题：

1. JS仅传递分组名称，未告知后端触发事件的pickerInput组件ID，导致后端默认更新固定组件
2. MutationObserver仅监听初始渲染的第一个.inner元素，无法覆盖动态加载（如标签页切换）的组件

解决方案 #

1. 修正JS代码（传递组件ID） #

更新JS逻辑，获取点击分组所属的组件ID，将组件ID与分组名一起传递给后端：

$(function() {
  $('body').on('DOMNodeInserted', '.bootstrap-select', function() {
    $('.dropdown-header', this).off('click').on('click', function() {
      const pickerId = $(this).closest('.bootstrap-select').attr('id');
      const groupName = $(this).children('span').text();
      Shiny.setInputValue(`group_select[${pickerId}]`, groupName, {priority: "event"});
    }).css('cursor', 'pointer');
  });
})

2. 修正Server端逻辑 #

根据传递的组件ID动态更新对应的pickerInput：

observeEvent(input$group_select, {
    req(input$group_select)
    pickerId <- names(input$group_select)[1]
    groupName <- input$group_select[[1]]
    if(all(choices[[groupName]] %in% input[[pickerId]])){
      sel <- input[[pickerId]][!(input[[pickerId]] %in% choices[[groupName]])]
    }else{
      sel <- union(input[[pickerId]], choices[[groupName]])
    }
    updatePickerInput(session, pickerId, selected = sel)
})

完整修正后代码 #

library(shiny)
library(shinyWidgets)

# 修正后的JS代码
js <- HTML("
$(function() {
  $('body').on('DOMNodeInserted', '.bootstrap-select', function() {
    $('.dropdown-header', this).off('click').on('click', function() {
      const pickerId = $(this).closest('.bootstrap-select').attr('id');
      const groupName = $(this).children('span').text();
      Shiny.setInputValue(`group_select[${pickerId}]`, groupName, {priority: \"event\"});
    }).css('cursor', 'pointer');
  });
})
")

choices <- list("A" = c(1, 2, 3, 4, 5), "B" = c(6, 7, 8, 9, 10), "C" = c(11,12,13,14,15))

ui <- fluidPage(
    tags$head(tags$script(js)),
    pickerInput("test", choices = choices, multiple = TRUE,options = list('actions-box' = TRUE)),
    textOutput("testOutput"),
    pickerInput("test_2", choices = choices, multiple = TRUE,options = list('actions-box' = TRUE)),
    textOutput("testOutput_2")
)

server <- function(input, output, session) {
    output$testOutput <- renderText({paste(input$test)})
    output$testOutput_2 <- renderText({paste(input$test_2)})
    
    # 修正后的observeEvent逻辑
    observeEvent(input$group_select, {
        req(input$group_select)
        pickerId <- names(input$group_select)[1]
        groupName <- input$group_select[[1]]
        if(all(choices[[groupName]] %in% input[[pickerId]])){
          sel <- input[[pickerId]][!(input[[pickerId]] %in% choices[[groupName]])]
        }else{
          sel <- union(input[[pickerId]], choices[[groupName]])
        }
        updatePickerInput(session, pickerId, selected = sel)
    }) 
}

shinyApp(ui = ui, server = server)

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