В моем следующем примере я пытаюсь отфильтровать набор данных 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)