Search code examples
rshinydygraphs

Change reactive time for dygraph's dyRangeSelector in Shiny


I'm building a Shiny application where I want to use the dyRangeSelector from dygraphs to provide the input period.

My problem is that I only want the reactive change to fire when the selector receives a "MouseUp"-event, ie., when the user is done with choosing the period. Right now events are dispatched as the selector is moved which results in a lagged app since the computations done for each period take a few seconds. Essentially, Shiny is too reactive for my taste here (I know this it the wrong way round - normally we want the apps to be super reactive).

Can I modify when the reactive request is dispatched?

Here's a small example that shows the problem.

library(quantmod)
library(shiny)
library(dygraphs)
library(magrittr)

# Create simple user interface
ui <- shinyUI(fluidPage(

    sidebarLayout(
    sidebarPanel(
            dygraphOutput("dygraph")
            ),    
    mainPanel(
            plotOutput("complicatedPlot")
            )
    )
))

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

    ## Read the data once.                                                                                       
    dataInput <- reactive({
    getSymbols("NASDAQ:GOOG", src = "google",
                   from = "2017-01-01",
                   auto.assign = FALSE)
    })

    ## Extract the from and to from the selector    
    values <- reactiveValues()    

    observe({
        if (!is.null(input$dygraph_date_window)) {
            rangewindow <- strftime(input$dygraph_date_window[[1]], "%Y-%m-%d")
            from <- rangewindow[1]
            to <- rangewindow[2]
        } else {
            from <- "2017-02-01"
            to <- Sys.Date()+1
        }
        values[["from"]] <- from
        values[["to"]] <- to
    })

    ## Render the range selector    
    output$dygraph <- renderDygraph({
        dygraph(dataInput()[,4]) %>% dyRangeSelector() %>% dyOptions(retainDateWindow = TRUE)
    })

    ## Render the "complicated" plot
    output$complicatedPlot <- renderPlot({
        plot(1,1)
        text(1,1, values[["from"]])
        Sys.sleep(1) ## Inserted to represent computing time
    })
})

## run app                                                                                                                                                                                                                         
runApp(list(ui=ui, server=server))

Solution

  • There is a function in shiny called debounce which might pretty much suit your needs. If you rewrite the limits to a reactive expression (as opposed to observe), you can wrap it into debounce with a specification of time in milliseconds to wait before evaluation. Here is an example with 1000ms:

    library(quantmod)
    library(shiny)
    library(dygraphs)
    library(magrittr)
    
    # Create simple user interface
    ui <- shinyUI(fluidPage(
    
      sidebarLayout(
        sidebarPanel(
          dygraphOutput("dygraph")
        ),    
        mainPanel(
          plotOutput("complicatedPlot")
        )
      )
    ))
    
    server <- shinyServer(function(input, output) {
    
      ## Read the data once.                                                                                       
      dataInput <- reactive({
        getSymbols("NASDAQ:GOOG", src = "google",
                   from = "2017-01-01",
                   auto.assign = FALSE)
      })
    
      ## Extract the from and to from the selector    
      values <- reactiveValues()    
    
      limits <- debounce(reactive({
        if (!is.null(input$dygraph_date_window)) {
          rangewindow <- strftime(input$dygraph_date_window[[1]], "%Y-%m-%d")
          from <- rangewindow[1]
          to <- rangewindow[2]
        } else {
          from <- "2017-02-01"
          to <- Sys.Date()+1
        }
        list(from = from,
             to = to)
      }), 1000)
    
      ## Render the range selector    
      output$dygraph <- renderDygraph({
        dygraph(dataInput()[,4]) %>% dyRangeSelector() %>% dyOptions(retainDateWindow = TRUE)
      })
    
      ## Render the "complicated" plot
      output$complicatedPlot <- renderPlot({
        plot(1,1)
        text(1,1, limits()[["from"]])
        Sys.sleep(1) ## Inserted to represent computing time
      })
    })
    
    ## run app                                                                                                                                                                                                                         
    runApp(list(ui=ui, server=server))
    

    This basically means that the reactive expression must be returning the same value for at least 1s to be send to its dependencies. You can experiment with the best time.