当用户单击某个页面时如何加载和呈现部分数据

问题描述

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

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

原始数据表 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),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()
          )
        ))
    })
  }
)

如果您有任何其他建议，也请告诉我。我的主要目标是防止一次加载 R 中的所有表，而是仅按需加载部分。

PS：我对任何 HTML、CSS 和 JS 都不熟悉，请耐心等待并提供尽可能详细的信息，在此先感谢！

解决方法

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

在funcFilter中使用renderDT，我们可以创建一个新的数据源并渲染到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