CODEWITHSUNDEEP
rshinyshiny-reactivity
Pascal Schmidt
Pascal Schmidt

Reputation: 243

Update Select Input Reactive Triggers Twice in R Shiny

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()
  })
  
}

Upvotes: 0

Views: 884

Answers (2)

guasi
guasi

Reputation: 1769

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)

Upvotes: 1

St&#233;phane Laurent
St&#233;phane Laurent

Reputation: 84519

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)

Upvotes: 1

Related Questions