Update other menus based on selection from another menu - r

Question

I currently have a Shiny app with 3 menus (more to be added once the bugs are worked out).
I have found examples online of a top down menu filtering approach. Meaning the user must select from the first menu, then the second menu, and so on, but in order. If they select from the 2nd menu first then it does not filter the first menu, only the ones below it and obviously that is a problem.
I want my users to be able to jump around to the menus in any order and have them filter.
In my example there are 3 menus, and what I am trying to do is if observeEvent on any menu (user makes a selection from any menu) then:
Filter the data based on the selection made
updateSelectInput for any menus that have no input selected yet
This will ensure that the menus are up to date with what is actually in the data and ensures that the user doesn't slice down to something that does not actually exist in the data.
Also, note that step #2 is very important - only update menus with no selection made, I have had issues with this because if I just update all other menus then it clears the user selected input, which is still the wrong behavior.
I know what I need to do but I have not been able to pull it off yet, so the help is appreciated.
Update
I updated my code to work with the one answer posted below but it still does not quite work correctly.
Now it does filter down the menus, however, once the subset has been created, it does not allow for it to "filter" back up.
What I mean by this is that If I select the value 3 from the first menu TreeNumber then the last menu filters down to just the value 300 - that is good. BUT if I then go back to the first menu and also select the value 4, I expect that the Circumference menu will now show the values: 300 and 400, however, it still only shows the value 300.
Updated Code:
d <- data.frame("TreeNumber" = c(replicate(7, 1), replicate(7, 2),
replicate(7, 3), replicate(7, 4)),
"TreeAge" = c(1:28),
"Circumference" = c(replicate(7, 100), replicate(7, 200),
replicate(7, 300), replicate(7, 400)))
col_names <- names(d)
# TODO - change these to: "Tree Number", "Tree Age", "Circumference"
user_friendly_names <- c('TreeNumber', 'TreeAge', 'Circumference')
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
h3("Filters:"),
uiOutput("filters"),
# Plot button
fluidRow(column(2, align = "right",
actionButton("plot_graph_button", "Plot")))
),
mainPanel(tableOutput("summary"))
)
)
server <- function(input, output, session) {
#### Create the filter lists for UI ####
output$filters <- renderUI({
if(is.null(col_names)) return(NULL)
lapply(1:length(col_names), function(i) {
col <- paste0(col_names[i])
alias <- user_friendly_names[i]
# Populate input with unique values from column
pickerInput(inputId = alias, label = paste(alias,':'),
choices = unique(d[[col]]), multiple = T)
})
})
# lapply(X = vars, FUN = function(x) {
# vals <- sort(unique(data[[x]]))
# updatePickerInput(session = session, inputId = x, choices = vals)
# })
my_filter <- function(data, var) {
# TODO - Need to convert from user_friendly_names --> col_names in here
if (length(input[[var]]) == 0) return(data)
data %>% subset(data[[var]] %in% input[[var]])
}
subsettedData <- reactive({
d %>% my_filter("TreeNumber") %>% my_filter("TreeAge") %>%
my_filter("Circumference")
# TODO - get into for loop versus hard coding this step:
# for(z in 1:length(col_names)){
# d %>% my_filter(col_names[z])
# }
})
observeEvent(subsettedData(), {
lapply(col_names, function(var) {
selections <- unique(subsettedData()[[var]])
if (length(input[[var]]) == 0)
updatePickerInput(session = session, inputId = var, choices = selections)
})
})
observeEvent(input$plot_graph_button, {
for (j in seq_along(d)) {
updateSelectInput(session = session, inputId = user_friendly_names[j],
choices = c("All", unique(d[[j]])), selected = "All")
}
})
output$summary <- renderTable({
# Do not show a plot when the page first loads
# Wait until the user clicks "Plot" button
if (input$plot_graph_button == 0){
return()
}
# Update code below everytime the "Plot" button is clicked
input$plot_graph_button
isolate({
# Fresh copy of the full data set every time "Plot" button is clicked
d <- copy(Orange)
# Filter data based on UI
for(f in 1:length(col_names)){
if(eval(parse(text = paste0('is.null(input$',user_friendly_names[f],')')))){
# Default to "All" - do not filter
print("All")
}else{
d <- d[d[[col_names[f]]] ==
unlist(eval(parse(text =
paste0('input$',user_friendly_names[f])))), ]
}
}
final_summary_table <<- d
})
})
}
shinyApp(ui = ui, server = server)

Answer 1

Here is an app that applies filtering based on all inputs. I'm not sure how intuitive it is to give a selection called "all" in a selectInput with multiple = TRUE. Maybe It would be better to add a reset button for each selection instead.
I replaced the dataset Orange with tips to get more factor variables. Also, I didn't use data.table in the example since it seems irrelevant for your problem.
library(shiny)
library(dplyr)
data(tips, package = "reshape2")
filter_vars <- c("sex", "smoker", "day", "time")
ui <- fluidPage(
lapply(filter_vars, function(var) {
selectInput(var, var, unique(tips[[var]]), multiple = TRUE)
}),
tableOutput("table")
)
server <- function(input, output, session) {
my_filter <- function(data, var) {
if (length(input[[var]]) == 0) return(data)
data %>% subset(data[[var]] %in% input[[var]])
}
subsettedData <- reactive({
tips %>% my_filter("sex") %>% my_filter("smoker") %>%
my_filter("day") %>% my_filter("time")
})
observeEvent(subsettedData(), {
lapply(filter_vars, function(var) {
selections <- unique(subsettedData()[[var]])
if (length(input[[var]]) == 0)
updateSelectInput(session, var, choices = selections)
})
})
output$table <- renderTable({ subsettedData() })
}
shinyApp(ui, server)