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

Question

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

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

原来的datatables 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()
          )
        ))
    })
  }
)

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

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

Answer 1

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

在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