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.

回答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.

Once it’s heading towards hierarchical selection I really 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)

来源：https://stackoverflow.com/questions/53858369/shiny-selecting-groups-using-selectizeinput

标签

Shiny

shiny-reactivity