Как вернуть все значения вместо ни одного, когда selectInput пуст - PullRequest
0 голосов
/ 01 апреля 2020

В моем следующем примере я пытаюсь отфильтровать набор данных mtcars, используя два объекта selectInput. Они работают как положено, когда пользователь выбирает одно или несколько значений. Тем не менее, поведение по умолчанию для каждой selectInput инициализируется без выбранного значения, и это интерпретируется как означающее, что строки не возвращаются в таблицу DTOutput.

Как изменить это поведение так, чтобы "none" selected «в объекте selectInput» переводится как «вернуть все» для этой функции во фрейме данных?

Ключевым моментом здесь является то, что любое решение должно хорошо масштабироваться: придумывать сотни уникальных значений для нескольких функций. В идеале пользователь должен фильтровать по исключению : любой фильтр без ввода должен возвращать все свои параметры; любой фильтр с одним или несколькими пользовательскими значениями должен возвращать их только во фрейм данных.

Моя попытка сделать это аннотирована ниже, но не работает. Я также попробовал filters$cyl <- ifelse(is.null(input$cyl), ..., но это тоже не сработало.

## A simple test of filtering a data frame
library(shiny)
library(DT)
library(data.table)
library(shinythemes)
library(tidyverse)
rm(list = ls())

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("cyl", "cylinders", choices = unique(mtcars$cyl),
                  selected = "", # I tried with and without these selected arguments.
                  selectize = T, multiple = T),
      selectInput("gear", "gears", choices = unique(mtcars$gear),
                  selected = "",
                  selectize = T, multiple = T)
      ),
    mainPanel(
      DTOutput("cars"),
      textOutput("choices")
      )
    )
  )

server <- function(session, input, output) {
  #>>
  # An attempt to handle blank filter values to mean return all values
  filters <- reactiveValues(cyl = NULL,
                            gear = NULL)
  update <- reactive({
    paste(input$cyl, input$gear)
  })

  observeEvent(update(), {
    filters$cyl <- ifelse(input$cyl == "", unique(mtcars$cyl), input$cyl) # I also tried is.null(input$cyl)
    filters$gear  <-  ifelse(input$gear == "", unique(mtcars$gear), input$gear)
  })
  #<<

  #>>
  # Debug text field that *should* show all values when none selected for either selectInput
  output$choices <- renderText(paste(filters$cyl, filters$gear))
  #<<

  #>>
  # Output. This should render the whole table on initialisation but is blank
  output$cars <- renderDT(datatable(mtcars %>%
                                      filter(cyl %in% filters$cyl,
                                             gear %in% filters$gear)))
  #<<
}

# Create Shiny app ----
shinyApp(ui, server)

1 Ответ

0 голосов
/ 01 апреля 2020

Вы можете просто добавить те же значения, которые вы указали, к choices к selected.

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("cyl", "cylinders", choices = unique(mtcars$cyl),
                  selected = unique(mtcars$cyl), # I tried with and without these selected arguments.
                  selectize = T, multiple = T),
      selectInput("gear", "gears", choices = unique(mtcars$gear),
                  selected = unique(mtcars$gear),
                  selectize = T, multiple = T)
    ),
    mainPanel(
      DTOutput("cars"),
      textOutput("choices")
    )
  )
)

Если вы хотите иметь кнопку для выбора или отмены выбора всех, найдите это ТАК сообщение с решением, используя shinyWidgets.

...