CODEWITHSUNDEEP
rshinyshiny-reactivity
figNewton
figNewton

Reputation: 181

Shiny: Selecting groups using selectizeInput

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.

Upvotes: 3

Views: 2185

Answers (1)

ismirsehregal
ismirsehregal

Reputation: 33510

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:

Result

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

Upvotes: 3

Related Questions