I want to display a table where the user can dynamically filter the table based on one or more columns, with the different filters "respecting" each other. This is similar to some other questions (e.g., here, here, and here).
Initial display should be the full table. Columns that can be used for filtering are categorical, and multiple values are allowed for each column. Choices in the dropdown menus should reflect currently available values, so they should update based on selections made in other menus. There is no inherent parent/child hierarchy to the columns/menus/filters: the user should be able to begin filtering from any menu. Finally, if nothing was selected in a particular menu, that filter should be disregarded (instead of filtering everything out).
Ultimately, this also needs to scale to ~10 filters, so trying to avoid overly verbose solutions. Based on all this and related questions/answers, I came up with the following. Individual bits seem to work when testing, but not when put together:
library(shiny)
ui = fluidPage(
fluidRow(selectizeInput("cyl_select", "Select cylinder:","",multiple = TRUE), #using `selectizeInput` because real data requires adjusting the `maxOptions` setting
selectizeInput("gear_select","Select gear:", "",multiple = TRUE),
selectizeInput("carb_select","Select carburator:", "",multiple = TRUE)),
fluidRow(DTOutput("filtered_table")))
server <- function(input, output, session) {
df_mtcars = reactive({mtcars})
#filter based on user input
df_mtcars_filt = reactive({df_mtcars() %>%
{if (!is.null(input$cyl_select)) filter(.,cyl %in% input$cyl_select) else . } %>% #piped if/else: only filter if input$[selection_var] contains meaningful values, otherwise pass data unaltered
{if (!is.null(input$gear_select)) filter(.,gear %in% input$gear_select) else . } %>%
{if (!is.null(input$carb_select)) filter(.,carb %in% input$carb_select) else . }
})
#render
output$filtered_table = renderDT( df_mtcars_filt())
#update the choice list
observe({updateSelectizeInput(session,"cyl_select",choices = sort(unique(df_mtcars_filt()$cyl)))})
observe({updateSelectizeInput(session,"gear_select",choices = sort(unique(df_mtcars_filt()$gear)))})
observe({updateSelectizeInput(session,"carb_select",choices = sort(unique(df_mtcars_filt()$carb)))})
}
# run the app
shinyApp(ui = ui,
server = server,
options = list(launch.browser = TRUE))
If you have the requirement for a solution which should be scalable to a larger number of inputs (here: columns for filtering the data frame), then a suitable approach could be to rely on lapply
. Below this is e.g. used for generating the selectizeInput
and for generating the observeEvent()
on these inputs.
Besides the lapply
thing I made some adjustments on your provided code, e.g. a selected
argument is provided within the updateSelectizeInput
. One also has to be careful in order to avoid circular dependencies between the dataTable
and the input updates.
library(shiny)
library(DT)
cols <- c("cyl", "gear", "carb")
ui = fluidPage(
fluidRow(
lapply(cols, function(col) { # generate the inputs
selectizeInput(
paste0(col, "_select"),
paste("Select", col, ":"),
sort(unique(mtcars[[col]])),
multiple = TRUE
)
}
)
),
fluidRow(
DTOutput("filtered_table")
)
)
server <- function(input, output, session) {
df_mtcars <- reactive({mtcars})
df_mtcars_filt <- reactiveVal(mtcars)
output$filtered_table <- renderDT(df_mtcars_filt())
# generate a number of observers, reacting to input changes
lapply(cols, function(col) { # apply on all relevant columns
observeEvent(input[[paste0(col, "_select")]], { # event if input changed
# set data frame initially to the starting value
df_mtcars_filt(df_mtcars())
# filter data frame processing
lapply(cols, function(curCol) {
df_mtcars_filt(
df_mtcars_filt()[
df_mtcars_filt()[, curCol] %in% if (!is.null(input[[paste0(curCol, "_select")]]))
input[[paste0(curCol, "_select")]] else df_mtcars()[, curCol],
]
)
})
# input update processing
lapply(cols[!cols %in% col], function(colToUpdate) {
updateSelectizeInput(
session,
paste0(colToUpdate, "_select"),
choices = sort(unique(df_mtcars_filt()[[colToUpdate]])),
selected = input[[paste0(colToUpdate, "_select")]]
)
})
}, ignoreNULL = FALSE)
})
}
shinyApp(ui = ui, server = server)