有没有办法在 shinyWidgets 的 pickerInput 上 select 整组选择？

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 自动 select 1,2,3,4 和 5。或者如果我们点击 B，它会自动 selects 6， 7、8、9 和 10。

点击“A”后的期望输出：

感谢任何帮助，谢谢。

Answer 1

好的，这是使用 jsTreeR 针对您的情况拍摄的照片。该代码可以正常工作，并且可以满足您的要求，但不如 shinyWidgets 漂亮。我想有一种方法可以将这种方法（主要取自文档中的 jsTreeR 示例）与相结合，以创建看起来不错且具有您正在寻找的功能的东西。

library(shiny)
library(jsTreeR)
library(jsonlite)

#create nodes
nodes <- list(
  list(
    text="List A",
    type="root",
    children = list(
      list(
        text = "Option 1",
        type = "child"
      ),
      list(
        text = "Option 2",
        type = "child"
      ),
      list(
        text = "Option 3",
        type = "child"
      ),
      list(
        text = "Option 4",
        type = "child"
      ),
      list(
        text = "Option 5",
        type = "child"
      )
    )
  ),
  list(
    text="List B",
    type="root",
    children = list(
      list(
        text = "Option 6",
        type = "child"
      ),
      list(
        text = "Option 7",
        type = "child"
      ),
      list(
        text = "Option 8",
        type = "child"
      ),
      list(
        text = "Option 9",
        type = "child"
      ),
      list(
        text = "Option 10",
        type = "child"
      )
    )
  )
)

types <- list(
  root = list(
    icon = "none"
  ),
  child = list(
    icon = "none"
  )
)

#Use in shiny context - example taken from documentation for jsTreeR
ui <- fluidPage(
  br(),
  fluidRow(
    column(width = 4,
           jstreeOutput("jstree")
    ),
    column(width = 4,
           tags$fieldset(
             tags$legend("Selections - JSON format"),
             verbatimTextOutput("treeSelected_json")
           )
    ),
    column(width = 4,
           tags$fieldset(
             tags$legend("Selections - R list"), 
             verbatimTextOutput("treeSelected_R")
           )
    )
  )
)

server <- function(input, output) {
  output[["jstree"]] <- renderJstree(
    jstree(nodes, checkboxes = TRUE, multiple=TRUE, types=types)
  ) 
  
  output[["treeSelected_json"]] <- renderPrint({
    toJSON(input[["jstree_selected"]], pretty = TRUE, auto_unbox = TRUE)
  })
  
  output[["treeSelected_R"]] <- renderPrint({
    input[["jstree_selected"]]
  })
  
}


shinyApp(ui, server)

请注意，节点上没有附加数据 - 这只是获得了正确的 UI 功能。您必须将值附加到随后可用于下游计算的节点。

Answer 2

你可以使用一些 JS 来得到结果：

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)

说明

想法是为 header 行设置一个 onClick 事件，在其中设置一个 input 变量，您可以根据该变量在 Shiny 中做出反应。

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

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

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

因此，我使用 MutationObserver 在创建时添加 ('.drodown-header') 侦听器。不是最漂亮的解决方案，也不是资源保护解决方案，但至少是一个可行的解决方案。也许，您可以了解如何正确设置事件侦听器 w/o MutationObsever.

更新

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

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

有没有办法在 shinyWidgets 的 pickerInput 上 select 整组选择？

Is there a way to select an entire group of choices on a pickerInput from shinyWidgets?

r

shiny

shinywidgets

pickerinput

说明

更新