4

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.

Konrad Rudolph
  • 530,221
  • 131
  • 937
  • 1,214
TimovD
  • 43
  • 5
  • I'm not sure I understand what double loading problem you are talking about. Can you more explicitly describe the behavior you want? – MrFlick Oct 10 '19 at 16:27
  • @MrFlick have edited to describe the expected behavior more explicitly – TimovD Oct 10 '19 at 19:26
  • Are you opposed to a "draw table" button? Since `iris_table` depends on both `species` and `petal_width` but `petal_width` also depends on `species` there's a cascade of reactive elements resolving, causing `iris_table` to render twice. A button would allow both changes to be in place before rendering the table. A conceptually similar issue is discussed here: https://stackoverflow.com/questions/31161372/in-shiny-apps-for-r-how-do-i-delay-the-firing-of-a-reactive – Greg Oct 10 '19 at 20:31
  • @Greg a button is not what I'm looking for. I'm trying to promote Shiny over Tableau to my company so the expectations are that output elements change reactively (like in Tableau) without a button. The solution of TimTeaFan works perfectly. – TimovD Oct 11 '19 at 08:08

2 Answers2

2

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)
TimTeaFan
  • 17,549
  • 4
  • 18
  • 39
0

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)
Gerhard Burger
  • 1,379
  • 1
  • 16
  • 25