selectInput为空时如何返回所有值而不是无

Question

在下面的代表中，我尝试使用两个 selectInput 对象过滤 mtcars 数据集。当用户选择一个或多个值时，这些将按预期工作。但是，默认行为是每个 selectInput 都在未选择任何值的情况下进行初始化，这被解释为表示 DTOutput 表中没有返回任何行。

如何更改此行为，以便 selectInput 对象中的“未选择”转换为数据框中该功能的“全部返回”？

这里的关键是任何解决方案都应具有良好的可扩展性：考虑多个功能的数百个独特值。理想情况下，用户应该按exception进行过滤：任何没有输入的过滤器都应该返回其所有选项；任何具有一个或多个用户定义值的过滤器都应该只在数据框中返回这些值。

下面注释了我这样做的尝试，但不起作用。我也试过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)

Answer 1

您可以将提供给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")
    )
  )
)

如果你想要一个按钮来选择或取消选择全部，那么请找到这个SO post 以及使用shinyWidgets 的解决方案。