有没有办法从shinyWidgets的pickerInput上选择整组选项？

Question

这是一个简单的可重现示例：

library(shiny)
library(shinyWidgets)

ui <- fluidPage(
    pickerInput("test",choices=list("A"=c(1,2,3,4,5),"B"=c(6,7,8,9,10)),multiple=TRUE),
    textOutput("testOutput")
)

server <- function(input, output) {
    output$testOutput <- renderText({paste(input$test)})
}

shinyApp(ui = ui, server = server)

我想要的是点击 A 并让 pickerInput 自动选择 1、2、3、4 和 5。或者如果我们点击 B，它会自动选择 6、7、8、9 和 10。

单击“A”后所需的输出：

任何帮助表示赞赏，谢谢。

Answer 1

您可以使用 someJS来获得结果：

library(shiny)
library(shinyWidgets)

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

  function clickHandler(evt) {
    Shiny.setInputValue('group_select', $(this).children('span').text());
  }

  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))

ui <- fluidPage(
   tags$head(tags$script(js)),
   pickerInput("test", choices = choices, multiple = TRUE),
   textOutput("testOutput")
)

server <- function(input, output, session) {
   output$testOutput <- renderText({paste(input$test)})
   
   observeEvent(input$group_select, {
      req(input$group_select)
      updatePickerInput(session, "test", selected = choices[[input$group_select]])
   })
}

shinyApp(ui = ui, server = server)

解释

想法是你onClick为标题行设置一个事件，在那里你设置一个input变量，你可以在Shiny.

整个MutationObserver构造是一个粗略的解决方法，因为我无法让（委托的）事件侦听器工作。

我观察到的是（不带JavaScript专家）：

• 在第一次点击之前不会生成下拉列表的内容。因此，像$('.dropdown-header').on()woudl这样的直接事件侦听器不起作用，因为该元素尚不存在。
• 事件委托 a la$(document).on('click', '.dropdown-header', ...)也不起作用。我假设某处有一个stopPropagation阻止事件冒泡的地方。

因此，我使用MutationObserver来在('.drodown-header')创建监听器的那一刻添加它。不是最漂亮也不是资源保护的解决方案，但至少是一个有效的解决方案。也许，您可以了解如何在没有MutationObsever.

更新

如果要保留所有现有选择，可以observeEvent按如下方式更改：

observeEvent(input$group_select, {
   req(input$group_select)
   sel <- union(input$test, choices[[input$group_select]])
   updatePickerInput(session, "test", selected = sel)
})