Как загрузить данные с понижением частоты при масштабировании в R-графике?

Question

Я создал блестящее приложение R, которое имеет граф, основанный на таблице данных, которая динамически подставляется в checkboxGroupInput. Моя проблема в том, что когда я пытаюсь загрузить большие объемы данных (миллионы записей), он загружается очень медленно и / или вылетает.

Проведя еще несколько исследований, я наткнулся на технику "ленивой нагрузки" отсюда. Насколько я понимаю, этот метод существенно сокращает данные, загружая только количество точек данных, равное ширине окна графика. Когда пользователь увеличивает масштаб, он будет детализировать и загружать больше данных в пределах максимальных / минимальных значений dyRangeSelector. Я подозреваю, что это решит мою проблему, потому что при любом взаимодействии с графом будет загружено значительно меньше данных. Тем не менее, все примеры, представленные в этой ссылке, были в Javascript, и у меня возникли проблемы с переводом на R.

Я также попытался обработать файл GraphDataProvider.js как плагин dygraph, но мне не удалось заставить его работать должным образом.

Несколько быстрых заметок о моей реализации:

• Каждый элемент data_dict на сервере есть объект xts.
• do.call.cbind Вызов функции на сервере основан на этой реализации SO, и это очень быстро.

Моя текущая настройка по сути такая (я реорганизовал ее, чтобы сделать ее общей):

Настройка данных:

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 <- 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
    })
}

Сделать приложение:

shinyApp(ui, server)

Я был бы признателен за любую помощь, которую я могу получить в этом, это застало меня на некоторое время сейчас. Спасибо!