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)
Результат:
Редактировать: Также см. Более удобную альтернативную реализацию: библиотека ( collapsibleTree )