Synchronise Dygraph and DateRangeInput in Shiny
Just add a reactive for the current series and you should be good
current_series <- reactive({
range <- paste(input$plage[1], input$plage[2], sep = "/")
serie[range]
})
output$dessin <- renderDygraph({
dygraph(current_series()) %>%
dyRangeSelector(
dateWindow = input$plage+1) # +1 parce que voila...
})
You can define values that will check if the change is triggered by the user or by the reactivity. This allows you to control a chain reaction.
Because the dygraph is an output, I need to add an intermediate value that will change only if not triggered by the automatic reaction. Thus, the dygraph updates if we interact with it, or if triggered by the date selector. But not when the date selector is triggered by a change on the dygraph.
library(xts)
library(shiny)
library(dygraphs)
library(lubridate)
data("co2")
data <- as.vector(coredata(as.xts(co2)))
serie <- xts(x = data,order.by = seq(from=today(),by=1,length.out = length(data)))
ui <- fluidPage(
titlePanel("Dygraph & date range input"),
sidebarLayout(
sidebarPanel(
dateRangeInput('plage', label = "Selectionnez la période :",
start = start(serie), end = end(serie),
separator = " - ",
format = "dd mm yyyy", #"yyyy-mm-dd",
language = 'fr', weekstart = 1
)
),
mainPanel(
dygraphOutput("dessin")
)
)
)
server <- function(input, output,session) {
r <- reactiveValues(
change_datewindow = 0,
change_plage = 0,
change_datewindow_auto = 0,
change_plage_auto = 0,
plage = c( start(serie), end(serie))
)
observeEvent(input$dessin_date_window, {
message(crayon::blue("observeEvent_input_dessin_date_window"))
r$change_datewindow <- r$change_datewindow + 1
if (r$change_datewindow > r$change_datewindow_auto) {
r$change_plage_auto <- r$change_plage_auto + 1
r$change_datewindow_auto <- r$change_datewindow
start <- as.Date(ymd_hms(input$dessin_date_window[[1]]))
stop <- as.Date(ymd_hms(input$dessin_date_window[[2]]))
updateDateRangeInput(session = session,
inputId = "plage",
start = start,end = stop
)
} else {
if (r$change_datewindow >= 10) {
r$change_datewindow_auto <- r$change_datewindow <- 0
}
}
})
observeEvent(input$plage, {
message("observeEvent_input_plage")
r$change_plage <- r$change_plage + 1
if (r$change_plage > r$change_plage_auto) {
message("event input_year update")
r$change_datewindow_auto <- r$change_datewindow_auto + 1
r$change_plage_auto <- r$change_plage
r$plage <- input$plage
} else {
if (r$change_plage >= 10) {
r$change_plage_auto <- r$change_plage <- 0
}
}
})
output$dessin <- renderDygraph({
message("renderDygraph")
dygraph(serie) %>%
dyRangeSelector(
dateWindow = r$plage + 1) # +1 parce que voila...
})
}
# Run the application
shinyApp(ui = ui, server = server)
Note that I added a reset of the counters when above 10. This is too avoid the trigger value to be to high for R. When the counter resets, you may notice a small outburst, depending on the speed your users change the slider. You can increase this value to make it appear less often.
I added some messages so that you can verify that there is not chain reaction.