How to load down-sampled data while zooming in R dygraph? - r

Question

I created an R shiny application that has a dygraph based on a data table that is dynamically subsetted by a checkboxGroupInput. My problem is, when I attempt to load large amounts of data (millions of records), it loads very slowly and/or crashes.
After doing some more research, I stumbled upon a "lazy-load" technique from here. Based on my understanding, this technique essentially downsamples the data by only loading the number of data points equal to the width of the dygraph window. As the user zooms in, it will drill down and load more data within the dyRangeSelector max/min dates. I suspect this will solve my problem, because it will load significantly less data at any given dygraph interaction. However, all of the examples provided in this link were in Javascript, and I'm having trouble translating it to R.
I also attempted to treat the GraphDataProvider.js file as a dygraph plugin, but I was unable to get it to work properly.
A couple of quick notes on my implementation:
Each element of data_dict in the server is an xts object.
The do.call.cbind function call in the server is based off of this SO implementation, and it is very fast.
My current setup is essentially like this (I refactored it to make it generic):
Data Setup:
library(shiny)
library(shinydashboard)
library(dygraphs)
library(xts)
library(data.table)
start <- as.POSIXlt("2018-07-09 00:00:00","UTC")
end <- as.POSIXlt("2018-07-11 00:00:00","UTC")
x <- seq(start, end, by=0.5)
data <- data.frame(replicate(4,sample(0:1000,345601,rep=TRUE)))
data$timestamp <- x
data <- data[c("timestamp", "X1", "X2", "X3", "X4")]
data <- as.data.table(data)
filters <- c("X1","X2","X3","X4")
data_dict <- vector(mode="list", length=4)
names(data_dict) <- filters
data_dict[[1]] <- as.xts(data[,c('timestamp','X1')]); data_dict[[2]] <- as.xts(data[,c('timestamp','X2')])
data_dict[[3]] <- as.xts(data[,c('timestamp','X3')]); data_dict[[4]] <- as.xts(data[,c('timestamp','X4')])
# Needed to quickly cbind the xts objects
do.call.cbind <- function(lst){
while(length(lst) > 1) {
idxlst <- seq(from=1, to=length(lst), by=2)
lst <- lapply(idxlst, function(i) {
if(i==length(lst)) { return(lst[[i]]) }
return(cbind(lst[[i]], lst[[i+1]]))})}
lst[[1]]}
UI:
header <- dashboardHeader(title = "App")
body <- dashboardBody(
fluidRow(
column(width = 8,
box(
width = NULL,
solidHeader = TRUE,
dygraphOutput("graph")
)
),
column(width = 4,
box(
width = NULL,
checkboxGroupInput(
"data_selected",
"Filter",
choices = filters,
selected = filters[1]
),
radioButtons(
"data_format",
"Format",
choices=c("Rolling Averages","Raw"),
selected="Rolling Averages",
inline=TRUE
)
)
)
)
)
ui <- dashboardPage(
header,
dashboardSidebar(disable=TRUE),
body
)
Server:
server <- function(input, output) {
# Reactively subsets the dataset based on checkboxGroupInput filters
the_data <- reactive({
data <- do.call.cbind(data_dict[input$data_selected]) # Column bind multiple xts objects
})
output$graph <- renderDygraph({
graph <- dygraph(the_data()) %>%
dyRangeSelector(c("2018-07-10 00:00:00","2018-07-10 02:00:00")) %>%
dyOptions(useDataTimezone = TRUE,connectSeparatedPoints = TRUE)
if(input$data_format == "Rolling Averages") graph <- graph %>% dyRoller(rollPeriod = 100)
graph
})
}
Make App:
shinyApp(ui, server)
I would appreciate any help I can get on this, this has stumbled me for a while now. Thank you!