Preventing double draw in a shiny app on select change

Question

I have a shiny app where changes to selectInputs trigger both updates to other selects AND trigger a plot update. There are situations, unfortunately, where changing a select causes a plot to re-draw, then it updates another select and the plot draws a second time. So I end up with a plot re-drawing multiple times. My shiny app is more complex than the one below but I've distilled the issue.

I want a change to the plot whenever the user changes a country, year or a title. But when the user changes a country it can also end up updating the year automatically and this can result in an update to the plot associated with country and then a re-draw associated with year.

Is there a way to allow for a brief delay, perhaps, for shiny to "catch up" and not have both reactives trigger the plot? Or perhaps there are other options?

library(shiny)
server <- function(input, output, session) {
  output$plot <- renderPlot({
        Sys.sleep(0.2)
        plot(1:10, main=input$title)
        rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = sample(colors() ,1))
  })

  observeEvent(input$country, {
    vals <- switch(input$country,
                   US = 2001:2003,
                   UK = 2001:2005,
                   FR = 2002:2006)

    updateSelectInput(session, "year", choices = vals, selected = vals[1])
  })

  observeEvent(c(input$country, input$year), {

    updateNumericInput(session, "title", 
                       value = paste(input$country, input$year))
  })

} 

ui <- fluidPage(

  tags$div(class="panel-body",

           selectInput("country", "country", choices = c("US", "UK", "FR"), selected = "US"),
           textInput("title", "Give a title",  "This is my initital title"),
           selectInput("year", "year", choices = NULL, selected = NULL)

  ),

  plotOutput("plot")

)

shinyApp(ui = ui, server = server)

See my answer here: http://stackoverflow.com/questions/33806811/shiny-evaluates-twice/33842753#33842753 — Tonio Liebrand, Jan 28 '17 at 08:16
Isolate doesn't work in this context because I do want the reactive to trigger a response in some instances. — ZRoss, Jan 30 '17 at 15:27

Valter Beaković · Accepted Answer · 2017-01-30T19:46:37.503

From what I see in this specific case it could be enough to change the "title" observer:

observeEvent(input$year, {

            updateNumericInput(session, "title", 
                               value = paste(input$country, input$year))
    })

since every change in input$country will trigger the update of input$year removing input$country from the "title" observer should avoid double plotting. I have tested it locally and it works.

Let me know, it is a nice problem to solve...

!!! NOTE There is a bug in the answer. It does not work if the country is changed but the year was not changed. I have reworked the code:

    library(shiny)
    server <- function(input, output, session) {
            rv <- reactiveValues(trigger = FALSE)
            output$plot <- renderPlot({
                    Sys.sleep(0.2)
                    plot(1:10, main=input$title)
                    rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = sample(colors() ,1))
            })

            observeEvent(input$country, {
                    vals <- switch(input$country,
                                   US = 2001:2003,
                                   UK = 2001:2005,
                                   FR = 2002:2006)
                    rv$trigger = input$year == vals[1]
                    updateSelectInput(session, "year", choices = vals, selected = vals[1])
            })

            observeEvent(c(input$year, rv$trigger), {

                    updateNumericInput(session, "title", 
                                       value = paste(input$country, input$year))
                    if(rv$trigger == TRUE) {
                            rv$trigger = FALSE
                    }
            })

    } 

    ui <- fluidPage(

            tags$div(class="panel-body",

                     selectInput("country", "country", choices = c("US", "UK", "FR"), selected = "US"),
                     textInput("title", "Give a title",  "US 2001"),
                     selectInput("year", "year", choices = 2001:2003, selected = 2001)

            ),

            plotOutput("plot")

    )

    shinyApp(ui = ui, server = server)

I like this answer, you basically force the reactions onto one input -- the year so that country does not directly lead to triggering the plot update. (There is still a double draw on app load -- if you have suggestions for that let me know). — ZRoss, Jan 30 '17 at 15:40
Glad you like it! If initialization of the year and title with defaults is acceptable than the double draw on app load is avoided. I have modified the answer. — Valter Beaković, Jan 30 '17 at 19:47

Preventing double draw in a shiny app on select change

1 Answers1