How to implement interdependent inputs and an accordingly filtered table?

Question

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))

Answer 1

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)