Search code examples
rshinydygraphs

Keeping current date range in dygraphs when updating rollmean


I really like the zoom function of dygraphs for R and tried to combine it with shiny for a simple plot app. I can load and plot data, but when I change the rollmean factor via a slider input or add an event using a mouse click when zoomed in on part of the plot, the plot is rerendered with the maximum date range.

As an attempt to solve this, I defined a new reactive function that stores the current view at a mouse click. Although this does almost what I want, there are still some issues

(i) It only works after a mouse click (in the plot), so zooming and than changing the rollmean still restores the original scale until one makes a mouse click

(ii) panning does not work (smoothly) anymore

(iii) when a new data file is loaded, it does not adjust the date range to fit the new file.

MWE:

# ui.R

library(dygraphs)

shinyUI(fluidPage(

  titlePanel("Simple plot"),

  sidebarLayout(
    sidebarPanel(
      helpText("Data files must be 2 column format"),
      fileInput("inputfile",label = "Load File"),
      sliderInput("rollmean", label = "Running Average", 
                   value = 1, min = 1, max = 25, step = 1),
      textOutput("text1")
    ),
    mainPanel(
      dygraphOutput("dygraph")
    )
  )
))

and

# server.R

library(dygraphs)

shinyServer(function(input, output) {


  spectrum <- reactive({
    inFile <- input$inputfile
    read.table(inFile$datapath)
  })

  currentview <- reactive({
    if(is.null(input$dygraph_click$x))
      {return(NULL)}
    else
    {
      input$dygraph_date_window
    }
  })

  cut <- reactive({
    if (is.null(input$dygraph_click$x))
      return(NULL)
    cut <- input$dygraph_click$x
  })

  output$dygraph <- renderDygraph({
    if (is.null(input$inputfile)){
      return(NULL)
    }
    else{
      dygraph(spectrum(), main = input$inputfile$name) %>%
      dyOptions(drawXAxis = TRUE, drawYAxis = FALSE, drawGrid = FALSE,animatedZooms = FALSE) %>%
      dyRangeSelector(dateWindow = currentview(), fillColor = "") %>% 
      dyRoller(rollPeriod = input$rollmean, showRoller = FALSE) %>%
      dyEvent(cut())}
  })

  output$text1 <- renderText({ 
    paste("You have selected", input$dygraph_click$x)
  })

})

Here is a simple data file.


> sessionInfo()
R version 3.3.3 (2017-03-06)
Platform: x86_64-apple-darwin13.4.0 (64-bit)
Running under: OS X Yosemite 10.10.5

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods  
[7] base     

other attached packages:
[1] dygraphs_1.1.1.4 shiny_1.0.3     

loaded via a namespace (and not attached):
 [1] Rcpp_0.12.7     lattice_0.20-34 zoo_1.8-0       digest_0.6.10  
 [5] mime_0.5        grid_3.3.3      R6_2.2.1        xtable_1.8-2   
 [9] jsonlite_1.4    magrittr_1.5    xts_0.9-7       tools_3.3.3    
[13] htmlwidgets_0.8 httpuv_1.3.3    yaml_2.1.13     htmltools_0.3.5

Solution

  • I found a solution by using the retainDateWindow option of dyRangeSelector and a boolean parameter that is set to FALSE when new data is loaded. I also had to move the line containing the dyRangeSelector keyword to the end of the options block of dygraphs to get the desired behavior.

    new server.R file:

    # server.R
    
    library(dygraphs)
    
    shinyServer(function(input, output) {
    
    
      spectrum <- reactive({
        keepscale <<-FALSE
        inFile <- input$inputfile
        read.table(inFile$datapath)
      })
    
      cut <- reactive({
        if (is.null(input$dygraph_click$x))
          return(NULL)
        cut <- input$dygraph_click$x
      })
    
      output$dygraph <- renderDygraph({
        if (is.null(input$inputfile)){
          keepscale <<-FALSE
          return(NULL)
        }
        else{
          simpleplot<-dygraph(spectrum(), main = input$inputfile$name) %>%
          dyOptions(drawXAxis = TRUE, drawYAxis = FALSE, drawGrid = FALSE,animatedZooms = FALSE) %>%
          dyRoller(rollPeriod = input$rollmean, showRoller = FALSE) %>%
          dyEvent(cut()) %>%
          dyRangeSelector(retainDateWindow=keepscale, fillColor = "")}
          keepscale <<-TRUE
          return(simpleplot)
      })
    
      output$text1 <- renderText({ 
        paste("You have selected", input$dygraph_click$x)
      })
    
    })