Hierarchical input select - r

Question

Could you please help me solving an issue related to Hierarchical input select.
I build a simply app for hierarchical input selecting, where the choices of each selectInput are updating based on the previous user selection. The app works, but I have found some strange behavior, which I want to avoid if possible.
My first input is the sliderInput, where the user can select which rows of the mtcars table should be used for the further sub-selection.
Then the selected cars are shown in the first selectInput and after the user choose which cars he want to see, the second selectInput mpg is filtered respectively.
Then after pressing an Action button, the sub-selection is displayed as table output.
When the user start the procedure from the beginning by changing the sliderInput, only the cars choices are updated. If we press on mpg selectInput we can still see the old selection.
Off course when we select again some cars the mpg are getting updated.
Do you know some way to avoid this behavior. My goal is, that mpg is always empty after the sliderInput is getting updated and not showing the old selections.
Thank you.
John
# Hierarchical inputSelect Example with mtcars
library(shiny)
library(dplyr)
ui <- fluidPage(
mainPanel(
fluidRow(
column(width=2,
sliderInput(inputId = "RowsINP",label = "Rows",min=1, max = dim(mtcars)[1], value=16,step=1),
selectInput("carsINP", "cars", choices = NULL,multiple=TRUE),
selectInput("mpgINP", "mpg", choices = NULL,multiple=TRUE),
actionButton("actionINP", "action")
),
column(width=10,
tableOutput('table')
)
)
)
)
server <- function(input, output,session) {
mtcars_tab <- reactive({
req(input$RowsINP)
data.frame(cars=rownames(mtcars[1:input$RowsINP,]),mtcars[1:input$RowsINP,])
})
observeEvent(mtcars_tab(), {
updateSelectInput(session,"carsINP", choices = unique(mtcars_tab()$cars))
})
cars <- reactive({
req(input$carsINP)
filter(mtcars_tab(), cars %in% input$carsINP)
})
observeEvent(cars(), {
# Also tried this option and many others
# if (!isTruthy(input$carsINP[1])){choices <- NULL}
# else{ choices <- unique(arrange(cars(),mpg)$mpg)}
choices <- unique(arrange(cars(),mpg)$mpg)
updateSelectInput(session, "mpgINP", choices = choices)
})
mpg <-eventReactive(input$actionINP,{
filter(cars(), mpg %in% input$mpgINP)
})
output$table <- renderTable(mpg())
}
# Run the application
shinyApp(ui = ui, server = server)

Answer 1

In my opinion, uiOutput/renderUI is perfect for these situations. We can avoid using a bunch of observeEvent and updateSelectInput calls, and the dropdown choices are updated (effectively) instantaneously, so you won't see the issue you've shown in your example. I think it's also a little bit easier to follow.
library(dplyr)
library(shiny)
ui <- {
fluidPage(
fluidRow(
sliderInput(inputId = "rows",label = "Rows",
min=1, max = dim(mtcars)[1],
value=16, step=1),
uiOutput('car_selector'),
uiOutput('mpg_selector'),
actionButton('action', 'Action'),
dataTableOutput('table_data')
)
)
}
server <- function(input, output, session) {
# render the car selection input
output$car_selector <- renderUI({
selectInput('car_input', 'Cars',
choices = rownames(mtcars)[1:input$rows],
multiple = TRUE)
})
# render the mpg selection input
output$mpg_selector <- renderUI({
selectInput('mpg_input', 'mpg',
choices = mtcars[rownames(mtcars) %in% input$car_input, 'mpg'],
multiple = TRUE)
})
# update the table data when the action button is clicked
table_data <- eventReactive(input$action, {
mtcars[rownames(mtcars) %in% input$car_input & mtcars$mpg %in% input$mpg_input, ]
})
# render the table data
output$table_data <- renderDataTable(table_data())
}
shinyApp(ui, server)