Shiny：使用 selectizeInput 选择组

Question

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

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

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

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

感谢您的帮助。

Answer 1

Afaik 使用 selectizeInput，您将不得不依赖多个输入的嵌套/依赖选择来获得类似于您预期行为的东西。

一旦它走向分层选择，我真的很喜欢使用库 (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)