2

我创建了一个 R 闪亮应用程序，该应用程序具有基于由 checkboxGroupInput 动态子集的数据表的 dygraph。我的问题是，当我尝试加载大量数据（数百万条记录）时，它加载非常缓慢和/或崩溃。

在做了更多研究之后，我从这里偶然发现了一种“延迟加载”技术。根据我的理解，这种技术本质上是通过仅加载等于 dygraph 窗口宽度的数据点数量来对数据进行下采样。当用户放大时，它将向下钻取并在 dyRangeSelector 最大/最小日期内加载更多数据。我怀疑这会解决我的问题，因为它会在任何给定的 dygraph 交互中加载更少的数据。但是，此链接中提供的所有示例都是用 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]]}

用户界面：

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)

我会很感激我能得到的任何帮助，这让我绊倒了一段时间。谢谢！

4

0 回答 0