Prevent double loading of output when using updateSelectInput

user_4345385 0
Viewed 538

In Shiny, using updateSelectInput() to achieve conditional filters (where the selectable choices of filter B depend on filter A) is the accepted solution to many questions (like here). However, when implementing it I often run into output objects loading twice, which is not visible on small datasets but is on real larger datasets.

I have produced a minimal example on the iris dataset below with Sys.sleep() representing a time consuming operation to show the double load.

What is the best way to prevent this from happening? I feel like a good req() somewhere should do the trick but I can't find how and where.

library(shiny)
library(dplyr)

ui <- fluidPage(
      selectInput("species", "Species", choices=levels(iris$Species)),
      selectInput("petal_width", "Petal Width", ""),
      tableOutput("iris_table")
)

server <- function(session, input, output) {
  output$iris_table <- renderTable({
    Sys.sleep(2)  # to show the double loading time
    iris %>%
      filter(Species == input$species,
             Petal.Width == input$petal_width)
  })

  petal_width_options <- reactive({
    iris$Petal.Width[iris$Species == input$species]
  })

  observe({
    updateSelectInput(session, "petal_width", choices = petal_width_options())
  })
}

shinyApp(ui, server)

EDIT:

To be more specific: if you run the app and change the value of the top (Species) selector, e.g. to versicolor, the possible bottom selector (Petal Width) choices change accordingly which is what I want.

You can also see that the output table will load (render is maybe a beter term) twice. It does that, I assume, because of the execution order which first updates the species selector, than the table once (in this case temporarily resulting in an empty table) and the bottom selector once at about the same time and then the table again adjusting to the new bottom selector value. I want the table to only render once when both selector values are done updating.

shiny-reactivity shiny r
2 Answers

In your original code iris_table was invalidated (and then rerendered) once by changing input$species. Then input$pedal_width was updated through the observeEvent which in turn invalidated (and then rerendered) iris_table a second time.

Using isolate() should solve your problem without the need of an action button (which would be a valid alternative).

Isolating input$species in the renderTable call prevents iris_table from becoming invalidated (and in turn being rerendered) when input$species is changed. It might seem that isolating input$species prevents iris_table from being updated at all when only species is changed, however, since changing input$species always updates input$petal_width, iris_table will also be rerendered when the user only selects another species. 

library(shiny)
library(dplyr)

ui <- fluidPage(
  selectInput("species", "Species", choices=levels(iris$Species)),
  selectInput("petal_width", "Petal Width", ""),
  tableOutput("iris_table")
)

server <- function(session, input, output) {

  petal_width_options <- reactive({
    iris$Petal.Width[iris$Species == input$species]
  })

  observeEvent(petal_width_options(),{
    updateSelectInput(session, "petal_width", choices = petal_width_options())
  })


  output$iris_table <- renderTable({
    req(input$petal_width)
    Sys.sleep(2)  # to show the double loading time
    iris %>%
      filter(Species == isolate(input$species),
             Petal.Width == input$petal_width)


  })


}

shinyApp(ui, server)

You could also do it with an action button.

library(shiny)
library(dplyr)

ui <- fluidPage(
  selectInput("species", "Species", choices=levels(iris$Species)),
  selectInput("petal_width", "Petal Width", ""),
  actionButton("render", "update table"),
  tableOutput("iris_table")
)

server <- function(session, input, output) {

  petal_width_options <- reactive({
    iris$Petal.Width[iris$Species == input$species]
  })

  observeEvent(petal_width_options(),{
    updateSelectInput(session, "petal_width", choices = petal_width_options())
  })


  output$iris_table <- renderTable({
    input$render
    req(isolate(input$petal_width))
    Sys.sleep(2)  # to show the double loading time
    iris %>%
      filter(Species == isolate(input$species),
             Petal.Width == isolate(input$petal_width))


  })



}

shinyApp(ui, server)
user_93493020

So in my case the isolate() solution doesn't work, because for my data the filter value does not necessarily change.

An alternative solution is to use debounce(), this will cause intermediate values to be ignored for the specified time window. The code would then look like:

library(shiny)
library(dplyr)

ui <- fluidPage(
  selectInput("species", "Species", choices=levels(iris$Species)),
  selectInput("petal_width", "Petal Width", ""),
  tableOutput("iris_table")
)

server <- function(session, input, output) {
  output$iris_table <- renderTable({
    Sys.sleep(2)  # to show the double loading time
    iris_filtered()
  })

  iris_filtered <- reactive({
    iris %>%
      filter(Species == input$species,
             Petal.Width == input$petal_width)
  }) %>% debounce(100)

  petal_width_options <- reactive({
    iris$Petal.Width[iris$Species == input$species]
  })

  observe({
    updateSelectInput(session, "petal_width", choices = petal_width_options())
  })
}

shinyApp(ui, server)
user_14398430
Related