Shiny: Selecting groups using selectizeInput

Question

I have this vision where I have a selector and a user can click the group to select all items in that group. For example, please see this

When you click input box X2 or X4, I would like for the user to be able to click "Western" to select both California and Washington.

Ideally, I would like for the user to be able to select multiple regions, as well as be able to customize their selections (i.e choose "Western" region and look at some data. Then unselect "Washington" to focus on "California" and look at more data.

I'm thinking that if this isn't possible in a simple way, I should just have the regions as choices and use updateSelectInput() to update the selected values, when the user has selected a region.

Thank you for the help.

Answer 1

Afaik using selectizeInput you'll have to rely on a nested/dependent selection of multiple inputs to get something similar to your expected behavior. Please see my related answer on selectizeGroupUI.

Once it’s heading towards hierarchical selection I also like using library(d3Tree) as an alternative approach. Here is a modified version (adapted to your states link) of one of the d3Tree examples:

library(shiny)
library(d3Tree)
library(DT)
library(data.table)
library(datasets)

DT <- unique(data.table(state.region, state.division, state.name, state.area))
variables <- names(DT)
rootName <- "us.states"

ui <- fluidPage(fluidRow(
  column(
    7,
    column(8, style = "margin-top: 8px;",
      selectizeInput(
      "Hierarchy",
      "Tree Hierarchy",
      choices = variables,
      multiple = TRUE,
      selected = variables,
      options = list(plugins = list('drag_drop', 'remove_button'))
    )),
    column(4, tableOutput("clickView")),
    d3treeOutput(
      outputId = "d3",
      width = '1200px',
      height = '475px'
    ),
    column(12, DT::dataTableOutput("filterStatementsOut"))
  ),
  column(5, style = "margin-top: 10px;", DT::dataTableOutput('filteredTableOut'))
))

server <- function(input, output, session) {
  
  network <- reactiveValues(click = data.frame(name = NA, value = NA, depth = NA, id = NA))
  
  observeEvent(input$d3_update, {
    network$nodes <- unlist(input$d3_update$.nodesData)
    activeNode <- input$d3_update$.activeNode
    if (!is.null(activeNode))
      network$click <- jsonlite::fromJSON(activeNode)
  })
  
  output$clickView <- renderTable({
    req({as.data.table(network$click)})
  }, caption = 'Last Clicked Node', caption.placement = 'top')
  
  filteredTable <- eventReactive(network$nodes, {
    if (is.null(network$nodes)) {
      DT
    } else{
      filterStatements <- tree.filter(network$nodes, DT)
      filterStatements$FILTER <- gsub(pattern = rootName, replacement = variables[1], x = filterStatements$FILTER)
      network$filterStatements <- filterStatements
      DT[eval(parse(text = paste0(network$filterStatements$FILTER, collapse = " | ")))]
    }
  })
  
  output$d3 <- renderD3tree({
    if (is.null(input$Hierarchy)) {
      selectedCols <- variables
    } else{
      selectedCols <- input$Hierarchy
    }
    
    d3tree(
      data = list(
        root = df2tree(struct = DT[, ..selectedCols][, dummy.col := ''], rootname = rootName),
        layout = 'collapse'
      ),
      activeReturn = c('name', 'value', 'depth', 'id'),
      height = 18
    )
  })
  
  output$filterStatementsOut <- renderDataTable({
    req({network$filterStatements})
  }, caption = 'Generated filter statements', server = FALSE)
  
  output$filteredTableOut <- DT::renderDataTable({
    # browser()
    filteredTable()
  }, caption = 'Filtered table', server = FALSE, options = list(pageLength = 20))
  
}

shinyApp(ui = ui, server = server)

Result:

Edit: Please also see the more convenient alternative implementation: library(collapsibleTree)