rshinyr-dygraphs

How to improve the refresh rate of a dygraph in shiny?

I would like to go through a time series (having lots of points, here 2E6) using a shiny app and dygraphs. The script below is a minimal example that works nicely except that a change in the numeric input start results in a 5 seconds freeze of the display. In contrast, moving with the range selector results in almost no lag. So I guess it should be feasible but I had no luck sorting this out.

Is there a way to improve it ?

library(shiny)
library(dygraphs)

ui <- fluidPage(
  # Sidebar
  sidebarLayout(
    # Sidebar panel for inputs ----
    sidebarPanel(
    numericInput("start", label = "Start (iteration)", 
                   value = 1, step = 5E4),
    numericInput("duration", label = "Duration (iterations)", 
                 value = 5E4)
    ),
  # Main    
  mainPanel(
      dygraphOutput("plot")
    )
  )
)

server <- function(input, output) {
  z<-rnorm(2E6,1,10) # data
  time<-1:length(z)
  df<-data.frame(time,z)
  output$plot <- renderDygraph({
    dygraph(df) %>% dyRangeSelector(dateWindow = c(input$start,input$start+input$duration) ) 
  })
  
}
shinyApp(ui = ui, server = server)

Display

Solution

  • The reason for this behaviour is that whenever you change input$start (input$duration) the whole plot is re-rendered. When you simply change the selector handles, dygraph makes sure the relevant data is shown, without re-rendering the whole graph (that is in fact one of the features of dygraph).

    You can piggy-back on this behaviour with the help of a bit of JavaScript. The idea is the following:

    1. In your renderDygraph function you do not take dependencies on input$start (input$duration). This avoids that the whole graph is re-rendered whenever one of those values changes.

    2. You include an observer, which calls the dygraph JavaScript function updateOptions, which in turn updates the visible range on the x-axis (so basically the same as changing the range handles by hand).

    3. In order to do so you need to:

      1. Store the dygraph object upon rendering (we use htmlwidgtes::onRender to so so), such that we can call updateOptions later.
      2. Add a custom message handler, to invoke JavaScript from shiny (you could also use shinyjs which encapsulates this for you).

    Code speaks a thousand words, so here's a working example:

    library(shiny)
library(dygraphs)
library(htmlwidgets)

ch <- JS("
   var plots = [];
   Shiny.addCustomMessageHandler('adjust-x-axis', function(limits) {
     const dg = plots['plot'];
     if (dg) {
       dg.updateOptions({dateWindow: [limits.xmin, limits.xmax]});
     }
   });")

ui <- fluidPage(
   # Sidebar
   sidebarLayout(
      # Sidebar panel for inputs ----
      sidebarPanel(
         numericInput("start", label = "Start (iteration)", 
                      value = 1, step = 5E4),
         numericInput("duration", label = "Duration (iterations)", 
                      value = 5E4)
      ),
      # Main    
      mainPanel(
         tags$head(
           tags$script(
              ch,
              type = "text/javascript"
           ) 
         ),
         dygraphOutput("plot")
      )
   )
)



server <- function(input, output, session) {
   z <- rnorm(2E6, 1, 10) # data
   time <- 1:length(z)
   df <- data.frame(time, z)
   output$plot <- renderDygraph({
      dygraph(df) %>% 
         dyRangeSelector(dateWindow = c(1, 1 + 5E4)) %>% 
         onRender("function(el, x) {
           plots['plot'] = this.dygraph;
         }")
   })

   observe({
      start <- req(input$start)
      duration <- req(input$duration)
      session$sendCustomMessage(
         "adjust-x-axis", 
         list(xmin = start, xmax = start + duration)
         )
   })
}

shinyApp(ui = ui, server = server)