R Shiny How to create Dependent filters for Dataframe

Question

I need to create an application where I filter multiple fields from a data frame. When the first field is filtered (using Date Range), the user then has to filter several pickerInputs before the data is displayed in a table. I'm not sure if this is the best way to create dependent filters. I cannot seem to find enough resources. I have tried the following. However, I'm not sure why I keep getting this warning::

Warning:Error in: Problem with filter() input '..1' X Input '..1' must be of size 100 or 1, not size 0

get_data <- function(size){
  longs <- seq(from=40, to =90, by = 0.01)
  lats <- seq(from = 5, to= 50, by = 0.01)
  LONGITUDE <- sample(longs, size, rep = TRUE)
  LATITUDE <- sample(lats, size, rep = TRUE)
  df <- data.frame(cbind(LONGITUDE, LATITUDE))
  df$LOCATION <- sample(c("Location_A", "Location_B", "Location_C"), size, replace = T, prob = c(0.4, 0.4, 0.2))
  df$EQUIPMENT <- sample(c("Equipment_A", "Equipment_B", "Equipment_C", "Equipment_D"), size, replace = TRUE)
  startTime <- as.POSIXct("2016-01-01")
  endTime <- as.POSIXct("2019-01-31")
  df$DATE <- as.Date(sample(seq(startTime, endTime, 1), size))
  df$WEEKDAY <- weekdays(as.Date(df$DATE))
  
  return(df)
}

df <-get_data(100)

ui <- navbarPage(
  id = "navBar",
  title = "Data Exploration",
  theme = shinytheme("cerulean"), 
  shinyjs::useShinyjs(),
  selected = "Data",
  
  
  tabPanel("Data",
           fluidPage(
             sidebarPanel(
               
               
               div(id = "form",
                   uiOutput('timestamp'),
                   uiOutput('location'),
                   uiOutput('days_of_week'),
                   uiOutput('equipment_type'),
                   hr(),
                   HTML("<h3>Reset your filter settings here:</h3>"),
                   actionButton("resetAll", "Reset Entries"),
                   hr()),
               mainPanel(
                 DT::DTOutput("datatable"))))
  )
  
)#end the ui


server <- function(session, input, output){
  filter_data <- reactive({
    df %>%
      filter(DATE >= input$timestamp[1] & DATE <= input$timestamp[2]) %>%
      filter(LOCATION %in% input$location) %>%
      filter(WEEKDAY %in% input$days_of_week) %>%
      filter(EQUIPMENT %in% input$equipment_type)
  })
  
  output$timestamp <- renderUI({
    dateRangeInput('timestamp',label = 'Date range input:',start = min(df$DATE), end = max(df$DATE))
  })
  
  output$location <- renderUI({
    location <- reactive({
      df %>%
        filter(DATE >= input$timestamp[1] & DATE <= input$timestamp[2]) %>%
        pull(LOCATION) %>%
        as.character() %>% unique()
      
    })
    pickerInput('location', "Select Location:", choices = location(),selected = NULL, options = list(`actions-box` = TRUE),multiple = T)
  })
  
  output$days_of_week <- renderUI({
    days_of_week <- reactive({
      df %>%
        filter(DATE >= input$timestamp[1] & DATE <= input$timestamp[2]) %>%
        filter(LOCATION %in% input$location) %>%
        pull(WEEKDAY) %>%
        as.character() %>% unique()
      
    })
    pickerInput('days_of_week', 'Choose Weekdays:', choices=days_of_week(), selected = NULL, options = list(`actions-box` = TRUE),multiple = T)
  })
  
  output$equipment_type <- renderUI({
    equipment <- reactive({
      df %>%
        filter(DATE >= input$timestamp[1] & DATE <= input$timestamp[2]) %>%
        filter(LOCATION%in% input$location) %>%
        filter(WEEKDAY %in% input$days_of_week) %>%
        pull(EQUIPMENT) %>%
        as.character() %>% unique()
    })
    pickerInput('equipment_type', "Choose Equipment:", choices = equipment(),selected = NULL, options = list(`actions-box` = TRUE),multiple = T)
  })
  
  output$datatable <- DT::renderDT({
    filter_data()
  })
  
  #Allow the user to reset all their inputs
  observeEvent(input$resetAll, {
    reset("form")
  })
  
}

shinyApp(ui, server)

Answer 1

I think your warnings are due to input$timestamp being NULL the first time in your reactive expressions, before you create the dateRangeInput.

You could move your input to ui, and then use updatePickerInput when the dates change to alter your other inputs accordingly.

You might want to include two separate reaction expressions. One for filtering the data based on the date range, which will be used to update the other pickers. The second will include the other filters for location, equipment, and weekday, based on the picker selections.

See if this provides something closer to what you are looking for. I included what seemed to be the relevant packages at the top. I also adjusted your parentheses in the ui a bit.

library(shinythemes)
library(shinyWidgets)
library(shinyjs)
library(shiny)
library(dplyr)

get_data <- function(size){
  longs <- seq(from=40, to =90, by = 0.01)
  lats <- seq(from = 5, to= 50, by = 0.01)
  LONGITUDE <- sample(longs, size, rep = TRUE)
  LATITUDE <- sample(lats, size, rep = TRUE)
  df <- data.frame(cbind(LONGITUDE, LATITUDE))
  df$LOCATION <- sample(c("Location_A", "Location_B", "Location_C"), size, replace = T, prob = c(0.4, 0.4, 0.2))
  df$EQUIPMENT <- sample(c("Equipment_A", "Equipment_B", "Equipment_C", "Equipment_D"), size, replace = TRUE)
  startTime <- as.POSIXct("2016-01-01")
  endTime <- as.POSIXct("2019-01-31")
  df$DATE <- as.Date(sample(seq(startTime, endTime, 1), size))
  df$WEEKDAY <- weekdays(as.Date(df$DATE))
  
  return(df)
}

df <-get_data(100)

ui <- navbarPage(
  id = "navBar",
  title = "Data Exploration",
  theme = shinytheme("cerulean"), 
  shinyjs::useShinyjs(),
  selected = "Data",
  
  tabPanel("Data",
           fluidPage(
             sidebarPanel(
               div(id = "form",
                   dateRangeInput('timestamp', label = 'Date range input:', start = min(df$DATE), end = max(df$DATE)),
                   pickerInput('location', "Select Location:", choices = unique(df$LOCATION), options = list(`actions-box` = TRUE), multiple = T),
                   pickerInput('days_of_week', 'Choose Weekdays:', choices = unique(df$WEEKDAY), options = list(`actions-box` = TRUE), multiple = T),
                   pickerInput('equipment_type', "Choose Equipment:", choices = unique(df$EQUIPMENT), options = list(`actions-box` = TRUE), multiple = T),
                   hr(),
                   HTML("<h3>Reset your filter settings here:</h3>"),
                   actionButton("resetAll", "Reset Entries"),
                   hr())
               ),
               mainPanel(
                 DT::DTOutput("datatable")))
  )
)#end the ui

server <- function(session, input, output){
  
  filter_by_dates <- reactive({
    filter(df, DATE >= input$timestamp[1] & DATE <= input$timestamp[2])
  })
  
  filter_by_all <- reactive({
    fd <- filter_by_dates()
    
    if (!is.null(input$location)) {
      fd <- filter(fd, LOCATION %in% input$location)
    }
    
    if (!is.null(input$days_of_week)) {
      fd <- filter(fd, WEEKDAY %in% input$days_of_week)
    }
    
    if (!is.null(input$equipment_type)) {
      fd <- filter(fd, EQUIPMENT %in% input$equipment_type)
    }         
             
    return(fd)
  })
  
  observeEvent(input$timestamp, {
    updatePickerInput(session, 'location', "Select Location:", choices = unique(filter_by_dates()$LOCATION), selected = input$location)
    updatePickerInput(session, 'days_of_week', 'Choose Weekdays:', choices = unique(filter_by_dates()$WEEKDAY), selected = input$days_of_week)
    updatePickerInput(session, 'equipment_type', "Choose Equipment:", choices = unique(filter_by_dates()$EQUIPMENT), selected = input$equipment_type)
  })
  
  output$datatable <- DT::renderDT({
    filter_by_all()
  })
  
  #Allow the user to reset all their inputs
  observeEvent(input$resetAll, {
    reset("form")
  })
  
}

shinyApp(ui, server)

Edit (1/28/21): Based on the comment, it sounds like there is interest in updating all the input choices based on selections made.

If you substitute observeEvent with an observe, and use filter_by_all() instead of filter_by_date() in the three updatePickerInput, then all the non-date input choices will update whenever any changes are made to any input:

  observe({
    input$timestamp
    updatePickerInput(session, 'location', "Select Location:", choices = unique(filter_by_all()$LOCATION), selected = input$location)
    updatePickerInput(session, 'days_of_week', 'Choose Weekdays:', choices = unique(filter_by_all()$WEEKDAY), selected = input$days_of_week)
    updatePickerInput(session, 'equipment_type', "Choose Equipment:", choices = unique(filter_by_all()$EQUIPMENT), selected = input$equipment_type)
  })