selectInput alternative allowing selecting all items in group

Question

Are there any selectInput() alternatives that would allow to select or de-select all items in a group by clicking a group header?

I'm looking for something similar to the 4th example in https://multiple-select.wenzhixin.net.cn/examples#basic.html (although ideally group elements would be indented or otherwise distinct from group headers).

Answer 1

Here is an example with the jsTreeR package:

library(jsTreeR)
library(shiny)

nodes <- list(
  list(
    text = "RootA",
    data = list(group = TRUE),
    children = list(
      list(
        text = "ChildA1"
      ),
      list(
        text = "ChildA2"
      )
    )
  ),
  list(
    text = "RootB",
    data = list(group = TRUE),
    children = list(
      list(
        text = "ChildB1"
      ),
      list(
        text = "ChildB2"
      )
    )
  )
)

ui <- fluidPage(
  
  fluidRow(
    column(
      width = 6,
      jstreeOutput("jstree")
    ),
    column(
      width = 6,
      tags$fieldset(
        tags$legend("Selections"),
        verbatimTextOutput("Selections")
      )
    )
  )
  
)

server <- function(input, output){
  
  output[["jstree"]] <- renderJstree({
    jstree(nodes, checkboxes = TRUE, theme = "proton")
  })
  
  selections <- eventReactive(input[["jstree_selected"]], {
    selectedNodes <- Filter(
      function(x) !isTRUE(x$data$group),
      input[["jstree_selected"]]
    )
    lapply(selectedNodes, `[[`, "text")
  })
  
  output[["Selections"]] <- renderPrint({
    selections()
  })
  
}

shinyApp(ui, server)

---

EDIT

As of version 1.3.0 you don't need to filter anymore to get the selected leaves only. There's a new option selectLeavesOnly = TRUE:

library(jsTreeR)
library(shiny)

nodes <- list(
  list(
    text = "RootA",
    children = list(
      list(
        text = "ChildA1"
      ),
      list(
        text = "ChildA2"
      )
    )
  ),
  list(
    text = "RootB",
    children = list(
      list(
        text = "ChildB1"
      ),
      list(
        text = "ChildB2"
      )
    )
  )
)

ui <- fluidPage(

  fluidRow(
    column(
      width = 6,
      jstreeOutput("jstree")
    ),
    column(
      width = 6,
      tags$fieldset(
        tags$legend("Selections"),
        verbatimTextOutput("Selections")
      )
    )
  )

)

server <- function(input, output){

  output[["jstree"]] <- renderJstree({
    jstree(
      nodes, checkboxes = TRUE, theme = "proton",
      selectLeavesOnly = TRUE # <-- new option
    )
  })

  output[["Selections"]] <- renderPrint({
    input[["jstree_selected"]]
  })

}

shinyApp(ui, server)