How to link 2 widget options dynamically in R Shiny? - r

Question

I'm trying to link the two options Type Selection & Subtype Selection as shown in the image. So I expect if I click Beer under Type Selection, I wouldn't see ICE WINE RED in Subtype Selection as it isn't a subtype of beer. Any idea to link Type Selection & Subtype Selection, so everytime I check some types in Type Selection, I wouldn't see irrelated subtypes in Subtype Selection?
Not sure if you can see bcl dataset, if can't here is the data screenshot:
enter image description here
Here is my code for these 2 functions:
dput(head(bcl))
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("priceInput", "Price", 0, 100, c(25, 40), pre = "$"),
checkboxGroupInput(
"type",
label = "Type Selection:",
choices = c("BEER" = "BEER", "WINE" = "WINE", "SPIRITS" = "SPIRITS", "REFRESHMENT" = "REFRESHMENT"),
selected = c("BEER", "WINE")
),
checkboxInput("filterSubType", "Filter by Subtype", FALSE),
conditionalPanel(
condition = "input.filterSubType",
uiOutput("SubtypeSelectOutput")
),
)
),
mainPanel(
plotOutput("plot"),
br(), br(),
#tableOutput("prices")
DT::dataTableOutput("prices")
)
)
)
server <- function(input, output, session) {
output$SubtypeSelectOutput <- renderUI({
selectInput("subtypeInput", "Subtype",
sort(unique(bcl$Subtype)),
selected = "ALMOND",
multiple = TRUE)
})
output$summaryText <- renderText({
numOptions <- nrow(prices())
if (is.null(numOptions)) {
numOptions <- 0
}
paste0("We found ", numOptions, " options for you")
})
prices <- reactive({
prices <- bcl
if (is.null(input$subtypeInput)) {
return(NULL)
}
prices <- dplyr::filter(prices, Type %in% input$type)
if (input$filterSubType) {
prices <- dplyr::filter(prices, Subtype == input$subtypeInput)
}
prices <- dplyr::filter(prices, Price >= input$priceInput[1],
Price <= input$priceInput[2]
)
if(nrow(prices) == 0) {
return(NULL)
}
prices
})
output$plot <- renderPlot({
if (is.null(prices())) {
return(NULL)
}
ggplot(prices(), aes(Alcohol_Content, fill = Type)) +
geom_histogram(colour = "black") +
theme_classic(20)
})
output$prices <- DT::renderDataTable({
prices()
})
}
shinyApp(ui = ui, server = server)

Answer 1

Update your SubtypeSelectionOutput so that it filters based on the first input.
output$SubtypeSelectOutput <- renderUI({
selectInput("subtypeInput", "Subtype",
choices = bcl %>%
filter(type %in% input$type) %>%
pull(Subtype) %>%
unique() %>% sort(),
selected = "ALMOND",
multiple = TRUE)
})
This may not solve all of your issues with this app, but it will properly link Type Selection & Subtype Selection.