Shiny: выбор групп с использованием selectizeInput - PullRequest
0 голосов
/ 19 декабря 2018

У меня есть это видение, где у меня есть селектор, и пользователь может щелкнуть группу, чтобы выбрать все элементы в этой группе.Например, см. this

Когда вы щелкаете по полю ввода X2 или X4, я бы хотел, чтобы пользователь мог нажать «Западный», чтобы выбрать и Калифорнию, и Вашингтон.

В идеале, я бы хотел, чтобы пользователь мог выбирать несколько регионов, а также иметь возможность настраивать их выбор (т.е. выбрать «западный» регион и посмотреть на некоторые данные. Затем отменить выбор «Вашингтон», чтобысосредоточьтесь на «Калифорнии» и посмотрите на дополнительные данные.

Я думаю, что если это невозможно простым способом, мне просто нужно выбрать регионы в качестве вариантов и использовать updateSelectInput () для обновления выбранногозначения, когда пользователь выбрал регион.

Спасибо за помощь.

1 Ответ

0 голосов
/ 20 декабря 2018

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)

Результат:

Result

Редактировать: Также см. Более удобную альтернативную реализацию: библиотека ( collapsibleTree )

...