Update Select Input Reactive Triggers Twice in R Shiny - r

Question

I would like to update the options for the select input when someone chooses to filter for the cylinders. However, whenever I update the options in the select input by filtering for cylinders, the reactive fires two times. How can I avoid that?
library(tidyverse)
library(shiny)
library(DT)
data("mtcars")
mtcars <- mtcars %>% tibble::rownames_to_column(var = "cars")
ui <- fluidPage(
shiny::selectInput(
inputId = "cars",
label = "Cars",
choices = mtcars$cars,
selected = mtcars$cars,
multiple = TRUE
),
shiny::checkboxGroupInput(
inputId = "cyl",
label = "Cyl",
choices = unique(mtcars$cyl),
selected = unique(mtcars$cyl)
),
DT::dataTableOutput(outputId = "table")
)
server <- function(session, input, output) {
temp <- shiny::reactive({
temp <- mtcars %>%
dplyr::filter(cars %in% input$cars, cyl %in% input$cyl)
print("Reactive fires twice")
return(temp)
})
shiny::observeEvent(input$cyl, {
shiny::updateSelectInput(
session,
inputId = "cars",
choices = temp()$cars,
selected = temp()$cars
)
})
output$table <- DT::renderDataTable({
temp()
})
}

Answer 1

This solution uses reactive values and I believe avoids the double trigger as it separates trigger events.
library(tidyverse)
library(shiny)
library(DT)
data("mtcars")
mtcars <- mtcars %>% rownames_to_column(var = "cars")
ui <- fluidPage(
selectInput(
inputId = "cars",
label = "Cars",
choices = mtcars$cars,
selected = mtcars$cars,
multiple = TRUE
),
checkboxGroupInput(
inputId = "cyl",
label = "Cyl",
choices = unique(mtcars$cyl),
selected = unique(mtcars$cyl)
),
dataTableOutput(outputId = "table")
)
server <- function(session, input, output) {
r <- reactiveValues(
temp = mtcars
)
observeEvent(input$cyl, ignoreNULL = FALSE, {
r$temp <- mtcars %>%
filter(cyl %in% input$cyl)
updateSelectInput(session,"cars",choices = r$temp$cars, selected = r$temp$cars)
print(input$cyl)
})
observeEvent(input$cars, ignoreNULL = FALSE, {
r$temp <- mtcars %>%
filter(cars %in% input$cars)
})
output$table <- DT::renderDataTable({
r$temp
})
}
shinyApp(ui,server)

Answer 2

Here is a solution using a reactive value instead of a reactive conductor, a priority level for the observers, and freezeReactiveValue:
library(shiny)
library(DT)
data("mtcars")
mtcars <- mtcars %>% tibble::rownames_to_column(var = "cars")
ui <- fluidPage(
selectInput(
inputId = "cars",
label = "Cars",
choices = mtcars[["cars"]],
selected = mtcars[["cars"]],
multiple = TRUE
),
checkboxGroupInput(
inputId = "cyl",
label = "Cyl",
choices = unique(mtcars[["cyl"]]),
selected = unique(mtcars[["cyl"]])
),
DTOutput(outputId = "table")
)
server <- function(session, input, output) {
Temp <- reactiveVal()
observeEvent(list(input[["cars"]], input[["cyl"]]), {
temp <- mtcars %>%
dplyr::filter(cars %in% input[["cars"]], cyl %in% input[["cyl"]])
Temp(temp)
}, priority = 2) # higher priority than the other observer
observeEvent(input[["cyl"]], {
freezeReactiveValue(input, "cars") # prevents the above observer to trigger
updateSelectInput(
session,
inputId = "cars",
choices = mtcars[["cars"]], # don't use Temp() here, otherwise you can't select the removed items
selected = Temp()[["cars"]]
)
}, priority = 1)
output[["table"]] <- renderDT({
Temp()
})
}
shinyApp(ui, server)