Shiny：使用 selectizeInput 选择组

Question

我有一个愿景，我有一个选择器，用户可以单击该组来选择该组中的所有项目。例如，请参阅this

当您单击输入框X2或X4时，我希望用户能够单击“西部”来选择加利福尼亚州和华盛顿州。

理想情况下，我希望用户能够选择多个区域，并且能够自定义他们的选择（即选择“西部”区域并查看一些数据。然后取消选择“华盛顿”以专注于“加利福尼亚”并查看更多数据。

我想，如果这不可能以简单的方式实现，我应该只将区域作为选择，并在用户选择区域时使用 updateSelectInput() 更新所选值。

谢谢您的帮助。

Answer 1

据我所知，使用

selectizeInput

，您必须依赖多个输入的嵌套/依赖选择才能获得与您的预期行为类似的结果。请参阅我在 selectizeGroupUI 上的相关答案。

一旦走向分层选择，我也喜欢使用库（d3Tree）作为替代方法。 这是 d3Tree 示例之一的修改版本（适应您的状态链接）：

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)

结果：

编辑： 另请参阅更方便的替代实现：library(collapsibleTree)