如何在用户点击某个页面时加载和渲染部分数据

how to load & render part of data when user click on certain page

当我尝试加载多个 table 并在 shiny 中使用 DT 进行渲染时,我在 R 中遇到了内存不足的问题。

我想知道是否可以只向DT提供table结构(例如,没有行和列名称),并预加载前N行数据以在应用程序中显示,然后加载当用户单击另一页(启用分页)时,另外 N 行。我发现 DT 有一个 dataTableAjax 函数, return 一个 Ajax URL 并且可以被 DT 查询(不知道它是怎么做的)

原始数据table的JS库也有类似的功能(如果我没记错的话),如https://datatables.net/examples/server_side/defer_loading.html

例如,

sample_table <- data.frame(a = rnorm(1e7), b = rnorm(1e7), c = rnorm(1e7))

library(fst)

# write large data on disk
write_fst(sample_table, "sample_table.fst")

# how to load data on disk on-demand using Ajax?
shinyApp(
  ui = fluidPage(
    title = 'Server-side processing of DataTables',
    fluidRow(
      DT::dataTableOutput('tbl')
    )
  ),
  server = function(input, output, session) {
    # create a widget using an Ajax URL created above
    tbl_ajax_url <- reactiveVal({
      dataTableAjax(
        session, 
        read_fst("sample_table.fst", from = 1, to = 100, as.data.table = TRUE), 
        outputId = 'tbl')
    })
    observeEvent(input$tbl_rows_current, {
      rows <- input$tbl_rows_current
      tbl_ajax_url(dataTableAjax(
        session, 
        # random access like fst, only load required data when user click the page
        read_fst("sample_table.fst", from = min(rows), to = max(rows), 
                 as.data.table = TRUE), 
        outputId = 'tbl'))
    })

    output$tbl = DT::renderDataTable({
      datatable(data.table(
        a = numeric(), b = numeric(), c = numeric(),
        check.names = FALSE), rownames = FALSE, options = list(
          ajax = list(
            serverSide = TRUE, processing = TRUE,
            # not sure how to do this part, where url only return part of data
            url = tbl_ajax_url()
          )
        ))
    })
  }
)

如果您还有其他建议,也请告诉我。我的主要 objective 是 防止一次加载 R 中的所有 table ,而不是仅按需加载部分内容。

PS: 我对HTML, CSS & JS都不熟悉,请耐心等待并提供尽可能详细的信息,在此先感谢!

我自己想出了一个解决方案,但我只是放在这里以防有人感兴趣。

renderDT中使用funcFilter,我们可以创建一个新的数据源并渲染到DT。我创建了一个磁盘数据源,它只在需要时使用 fst.

读取保存在磁盘上的数据

代码:

sample_table <- data.frame(a = rnorm(1e7), b = rnorm(1e7), c = rnorm(1e7))

library(fst)
library(shiny)
library(DT)
library(data.table)

# write large data on disk
write_fst(sample_table, "sample_table.fst")

shinyApp(
  ui = fluidPage(
    title = 'Server-side processing of DataTables',
    fluidRow(
      DT::dataTableOutput('tbl')
    )
  ),
  server = function(input, output, session) {
    output$tbl = DT::renderDataTable({
      datatable(data.frame(
        a = numeric(), b = numeric(), c = numeric(),
        check.names = FALSE), rownames = FALSE)
    }, funcFilter = dataTablesFilterOnDisk)
  }
)

dataTablesFilterOnDisk <- function(data, params) {
  start <- as.integer(params$start)
  length <- as.integer(params$length)
  total_rows <- fst::metadata_fst("sample_table.fst")$nrOfRows
  cleanDataFrame <- function(x, escape = params$escape) {
    if (escape != "false") {
      k = seq_len(ncol(x))
      if (escape != "true") {
        k = k[as.integer(strsplit(escape, ",")[[1]])]
      }
      for (j in k) if (is.character(x[, j]) || is.factor(x[, j])) 
        x[, j] = htmltools::htmlEscape(x[, j])
    }
    x = unname(x)  # remove column names
    if (!is.data.frame(x)) return(x)
    for (j in seq_len(ncol(x))) {
      xj = x[, j]
      xj = unname(xj)  # remove names
      dim(xj) = NULL  # drop dimensions
      if (is.table(xj)) xj = c(xj)  # drop the table class
      x[[j]] = xj
    }
    unname(x)
  }
  row_range <- c(start + 1L, start + length)

  data <- fst::read_fst("sample_table.fst", columns = colnames(data), 
                        from = row_range[1L], 
                        to = min(row_range[2L], total_rows))
  
  list(draw = as.integer(params$draw), recordsTotal = total_rows, 
       recordsFiltered = total_rows, data = cleanDataFrame(data), 
       DT_rows_all = NULL, 
       DT_rows_current = seq.int(row_range[1L], row_range[2L], by = 1L))
}

查看更多参考资料:

  1. https://github.com/grahamrp/dtdatasources