How do I make sure that a shiny reactive plot only changes once all other reactives finish changing?

Question

I have a shiny app in which the user selects a bunch of inputs, such as the x range, y range, types of scaling and the selection of a particular subset of the data set through a drop down list.

This is all done through the use of reactives. X and Y range slider inputs react to changes in the selection of the data set because the minimum and maximum have to be found again. This takes maybe about 1-2 seconds while the shiny app is working and the user chooses a different option in the drop down list. During those 1-2 seconds, the plot switches to plotting the selected new subset of data with the old x and y range before quickly switching to the correct plot once the x and y range sliders change.

A fix would be to just refresh the plot on a button by isolating everything else. But would there be a way to keep the plot reactive to changes, but just wait until all the dependent things have finished calculating?

Thanks

This is the plot:

output$plot1 <- rCharts::renderChart2({    
    if(!is.null(input$date_of_interest) && 
         !is.null(input$xrange) && 
         !is.null(input$yrange) &&
         !is.null(data()) &&
         isolate(valid_date_of_interest())) {
      filtered_data<- dplyr::filter(isolate(data()), id==input$choice)
      p <- tryCatch(plot_high_chart(
                           data,
                           first_date_of_interest = input$date_of_interest, 
                           ylim = input$yrange,
                           xlim = input$xrange), 
                    error = function(e) e, 
                    warning = function(w) w)
      if(!inherits(p, "error") && !inherits(p, "warning")) {
        return(p)
      }
    } 
    return(rCharts::Highcharts$new())
  })

and x range(y range is similar):

output$xrange <- renderUI({
    if(!is.null(input$date_of_interest) && 
       !is.null(input$choice) &&
       !is.null(valid_date_of_interest()) &&
       isolate(valid_date_of_interest())) {
          temp_data <- dplyr::filter(isolate(data()), date == input$date_of_interest)
          temp <- data.table::data.table(temp_data, key = "child.id")
          the_days <- as.double(as.Date(temp$last.tradeable.dt) - as.Date(temp$date))
          min_days <- min(the_days,na.rm=TRUE)
          max_days <- max(the_days,na.rm=TRUE)
          sliderInput("xrange", 
                      "Days Range (X Axis)", 
                       step = 1,
                       min = 0,
                       max = max_days + 10,
                       value = c(min_days,max_days)
      )
    }
  })

and the input choice:

 output$choice<- renderUI({
    selectInput("choice", 
                "Choose:", 
                unique(data$id),
                selected = 1    
    )
  })

Some direction and suggestions to implement would be useful. I've thought about having global variables such as x_range_updated, y_range_updated, that are set to false in the code for output$choice and then set to true in the code for output$xrange, etc. And then have plot1 depend on them being true. Other suggestions to approach this problem would be appreciated.

Answer 1

Edit 2019-02-14

Since Shiny 1.0.0 (released after I originally wrote this answer), there is now a debounce function which adds functionality to help with this kind of task. For the most part, this avoids the need for the code I originally wrote, although under the hood it works in a similar manner. However, as far as I can tell, debounce doesn't offer any way of short-circuiting the delay with a redraw action button along the lines of what I'd done here. I've therefore created a modified version of debounce that offers this functionality:

library(shiny)
library(magrittr)

# Redefined in global namespace since it's not exported from shiny
`%OR%` <- shiny:::`%OR%`
debounce_sc <- function(r, millis, priority = 100, domain = getDefaultReactiveDomain(), short_circuit = NULL) 
{
  force(r)
  force(millis)
  if (!is.function(millis)) {
    origMillis <- millis
    millis <- function() origMillis
  }
  v <- reactiveValues(trigger = NULL, when = NULL)
  firstRun <- TRUE
  observe({
    r()
    if (firstRun) {
      firstRun <<- FALSE
      return()
    }
    v$when <- Sys.time() + millis()/1000
  }, label = "debounce tracker", domain = domain, priority = priority)
  # New code here to short circuit the timer when the short_circuit reactive
  # triggers
  if (inherits(short_circuit, "reactive")) {
    observe({
      short_circuit()
      v$when <- Sys.time()
    }, label = "debounce short circuit", domain = domain, priority = priority)
  }
  # New code ends
  observe({
    if (is.null(v$when)) 
      return()
    now <- Sys.time()
    if (now >= v$when) {
      v$trigger <- isolate(v$trigger %OR% 0) %% 999999999 + 
        1
      v$when <- NULL
    }
    else {
      invalidateLater((v$when - now) * 1000)
    }
  }, label = "debounce timer", domain = domain, priority = priority)
  er <- eventReactive(v$trigger, {
    r()
  }, label = "debounce result", ignoreNULL = FALSE, domain = domain)
  primer <- observe({
    primer$destroy()
    er()
  }, label = "debounce primer", domain = domain, priority = priority)
  er
}

This then permits a simplified shiny application. I've switched to the single file mode of working, but the UI remains the same as the original one.

ui <- fluidPage(
  titlePanel("Old Faithful Geyser Data"),
  sidebarLayout(
    sidebarPanel(
      sliderInput("bins",
                  "Number of bins:",
                  min = 1,
                  max = 50,
                  value = 30),
      selectInput("column", "Column", colnames(faithful), selected = "waiting"),
      actionButton("redraw", "Redraw")
    ),
    mainPanel(
      plotOutput("distPlot")
    )
  )
)
server <- function(input, output, session) {
  reac <- reactive(list(bins = input$bins, column  = input$column)) %>% 
    debounce_sc(5000, short_circuit = reactive(input$redraw))

  # Only triggered by the debounced reactive
  output$distPlot <- renderPlot({
    x    <- faithful[, reac()$column]
    bins <- seq(min(x), max(x), length.out = reac()$bins + 1)
    hist(x, breaks = bins, col = 'darkgray', border = 'white',
         main = sprintf("Histogram of %s", reac()$column))
  })
}
shinyApp(ui, server)

Original version (pre Shiny 1.0.0)

You haven't provided a reproducible example, so I've gone with something based on the Shiny faithful example that is the default in RStudio. The solution I've got will always have a (configurable) 5 second delay between an input changing and the graph being redrawn. Each change in input resets the timer. There's also a redraw button for the impatient which redraws the graph immediately. The values of the reactive value 'redraw' and the inputs are shown in the console every time an input changes or the timer ticks. This should be removed for production use. Hopefully this meets your needs!

library(shiny)
shinyUI(fluidPage(
  titlePanel("Old Faithful Geyser Data"),
  sidebarLayout(
    sidebarPanel(
      sliderInput("bins",
                  "Number of bins:",
                  min = 1,
                  max = 50,
                  value = 30),
      selectInput("column", "Column", colnames(faithful), selected = "waiting"),
      actionButton("redraw", "Redraw")
    ),
    mainPanel(
      plotOutput("distPlot")
    )
  )
))

server.R

library(shiny)
shinyServer(function(input, output, session) {
  reac <- reactiveValues(redraw = TRUE, bins = isolate(input$bins), column  = isolate(input$column))

  # If any inputs are changed, set the redraw parameter to FALSE
  observe({
    input$bins
    input$column
    reac$redraw <- FALSE
  })

  # This event will also fire for any inputs, but will also fire for
  # a timer and with the 'redraw now' button.
  # The net effect is that when an input is changed, a 5 second timer
  # is started. This will be reset any time that a further input is
  # changed. If it is allowed to lapse (or if the button is pressed)
  # then the inputs are copied into the reactiveValues which in turn
  # trigger the plot to be redrawn.
  observe({
    invalidateLater(5000, session)
    input$bins
    input$column
    input$redraw
    isolate(cat(reac$redraw, input$bins, input$column, "\n"))
    if (isolate(reac$redraw)) {
      reac$bins <- input$bins
      reac$column <- input$column
    } else {
      isolate(reac$redraw <- TRUE)
    }
  })

  # Only triggered when the copies of the inputs in reac are updated
  # by the code above
  output$distPlot <- renderPlot({
      x    <- faithful[, reac$column]
      bins <- seq(min(x), max(x), length.out = reac$bins + 1)
      hist(x, breaks = bins, col = 'darkgray', border = 'white',
           main = sprintf("Histogram of %s", reac$column))
  })
})