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

Posted 2023-03-24

【中文标题】有没有办法从shinyWidgets 的pickerInput 上选择一整组选项？

【英文标题】：Is there a way to select an entire group of choices on a pickerInput from shinyWidgets?

【发布时间】：2021-08-26 16:47:58

【问题描述】：

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

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”后想要的输出：

感谢您的帮助。

【问题讨论】：

您是否还希望保留从每个列表中选择单个元素的功能（例如，选择 1、3、5 和 6、7、8）？

是的，这很理想，我希望可以选择选择整个组或单个元素。或者例如选择整个组，然后取消选择一些元素

我想不出办法（尽管其他人仍然可能！），经过一番研究，看起来这是asked before。但是，似乎进展不大 - 链接的 Github 请求仍然开放，所以也许 cmets 中的建议仍然有效。

感谢您的浏览，我会查看该链接。还想补充一点，如果在shinyWidgets 中没有办法，我愿意使用其他包或基础闪亮。

一条有希望的道路...***.com/questions/60299185/…

【参考方案1】：

您可以使用一些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)

说明

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

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

我观察到的是（不带javascriptspecialist）：

在第一次点击之前没有生成下拉菜单的内容。因此，像 $('.dropdown-header').on() 这样的直接事件侦听器将不起作用，因为该元素尚不存在。 $(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)
)

【讨论】：

这很有趣。感谢您的回答。我还注意到，选择任何一个标题（即“A”或“B”）会取消选择另一个标题中的任何活动选择。这是由于您提到的其中一个项目符号吗？我对 JS 基本上一无所知，所以我可能在这里遗漏了一些基本的东西......

嗯，这是设计使然。 JavaScript 发送（在本例中）A 或 B 到 Shiny。然后shiny 决定选择与A 关联的所有元素。如果您想要其他行为，更改 oberserver...

相当容易

太棒了！这就是我一直在寻找的。我想在我不熟悉的 JS 中有一些方法可以做到这一点。我已经接受了你的回答。作为旁注，有没有办法以同样的方式取消选择一个组？非常感谢！

当然，您现在可以简单地收听input$group_select 并在您的服务器上做任何您想做的事情。它将始终返回组标签。您可能希望将 JS 更改为 Shiny.setInputValue(..., ..., priority: "event"，以确保 JS 告诉 shin 每次更改。

谢谢！我能够根据您的建议添加取消选择。添加了priority: \"event\"（必须转义引号）。然后将sel 行替换为以下内容：if (all(choices[[input$group_select]] %in% input$test)) sel <- input$test[!(input$test %in% choices[[input$group_select]])] else sel <- union(input$test, choices[[input$group_select]]) 希望能帮助其他有同样问题的人

【参考方案2】：

好的，这里是使用jsTreeR 为您的情况拍摄的一些内容。该代码可以正常工作并执行我认为您正在寻找的工作，但它不如shinyWidgets 漂亮。我想有一种方法可以结合这种方法（主要取自文档中的 jsTreeR 示例）和the approach to create bindings in this post，以创建看起来不错并具有您正在寻找的功能的东西。

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 功能。您必须将值附加到可用于下游计算的节点。

【讨论】：

好的，这很有趣，我已经投票赞成你的答案。快到了，有没有办法把它放在下拉列表中或删除文件夹图标？理想情况下，我想通过向量或列表填充选项，而不是输入“选项 1”、“选项 2”等。这是我见过的最接近的选项，花了几个小时查看两个闪亮的选项和js。

在上面包含了一个编辑以摆脱文件夹图标 - 但让它显示在下拉列表中可能需要使用那些闪亮的绑定，如@StéphaneLaurent 的其他答案所示。而且我确信lapply() 方法可以生成正确的列表结构，但我对这种事情并不是非常精通。