在 R 中使用 sapply() 的内存有效方式

Memory efficient way to use sapply() in R

我正在尝试减少我一直在处理的一段 R 代码的内存消耗。我正在使用 peakRAM() 函数来测量使用的最大 RAM。这是一个很长的代码,最后有一个简单的 sapply() 功能。我发现它是消耗最大内存的 sapply() 部分。所以我写了一个小函数 fun1() 模仿我那部分代码中的对象和 sapply() 函数,如下所示:

library(peakRAM)
fun1 <- function() {
  tm <- matrix(1, nrow = 300, ncol = 10)  #in the original code, the entries are different and nonzero
  print(object.size(tm))
  r <- sapply(1:20000, function(i) {
        colSums(tm[1:200,])  #in the original code, I am subsetting a 200 length vector which varies with i, stored in a list of length 20000
        })
  print(object.size(r))
  r
}

peakRAM(fun1())

如果你在 R 中 运行 这个,你会得到 peakRAM() 大约 330Mb 的消耗。但是您可以看到 tmr 这两个对象的大小都非常小(分别为 2Kb 和 1.6Mb),如果您查看 peakRAM() 来计算单个 colSums(tm[1:200,]),它非常小,大约 0.1Mb。所以感觉,在 sapply() 期间,R 可能在循环 1:20000 时没有清除内存。否则,由于单个 colSums(tm[1:200,]) 占用的内存很小,并且所有关联的对象都占用很小的内存,因此 sapply() 应该占用很小的内存。

在这方面,我已经知道 R 有一个 gc() 函数,可以在需要时清除不必要的内存,并且可能 R 在 sapply() 期间没有清除内存,这导致了这个高内存消耗。如果那是真的,我想知道是否有办法摆脱它并完成工作而不需要这么多额外的内存?请注意,我不想在 运行-时间上妥协。

这是您的函数,已修改为使用 vapply 而不是 sapply.colSums 而不是 colSums:

f1 <- function(x, l) {
    n <- ncol(x)
    FUN <- function(i) .colSums(x[i, , drop = FALSE], length(i), n)
    vapply(l, FUN, double(n), USE.NAMES = FALSE)
}

这是一个 C 实现,通过 inline 包可供 R 访问:

sig <- c(x = "double", l = "list")
bod <- '
double *px = REAL(x);
R_xlen_t nx = XLENGTH(x);
int *d = INTEGER(getAttrib(x, R_DimSymbol));
int m = d[0];
int n = d[1];
R_xlen_t N = XLENGTH(l);

SEXP res = PROTECT(allocMatrix(REALSXP, n, N));
double *pres = REAL(res);

SEXP index;
R_xlen_t nindex;
int *pindex;
double sum;

for (R_xlen_t i = 0, rpos = 0; i < N; ++i)
{
    index = VECTOR_ELT(l, i);
    nindex = XLENGTH(index);
    pindex = INTEGER(index);
    for (R_xlen_t xpos = 0; xpos < nx; xpos += m, ++rpos)
    {
        sum = 0.0;
        for (R_xlen_t k = 0; k < nindex; ++k)
        {
            sum += px[xpos + pindex[k] - 1];
        }
        pres[rpos] = sum;
    }
}
UNPROTECT(1);
return res;
'
f2 <- inline::cfunction(sig, bod, language = "C")

这里的 C 代码非常少,所以我坚持使用 R API. You can write equivalent C++ code using the Rcpp API,您可能会发现它更容易理解。

这是一个显示 f1f2 给出相同结果的测试:

set.seed(1L)
m <- 300L
n <- 10L
x <- matrix(rnorm(m * n), m, n)
l <- replicate(2e+04, sample(m, size = 200L, replace = TRUE), simplify = FALSE)
identical(f1(x, l), f2(x, l))
## [1] TRUE

这是在我的机器上分析 f1(x, l)f2(x, l) 的结果:

gc(FALSE)
Rprof("f.out", interval = 1e-05, memory.profiling = TRUE)
f1(x, l)
f2(x, l)
Rprof(NULL)
summaryRprof("f.out", memory = "both")[["by.total"]][c("\"f1\"", "\"f2\""), c("total.time", "mem.total")]
     total.time mem.total
"f1"      0.119     344.4
"f2"      0.001       1.5

f1 调用耗时 0.119 秒,消耗 344.4 MiB 内存。 f2 调用耗时 0.001 秒并消耗 1.5 MiB 内存——这或多或少等于 return 值的大小。 (请谨慎解读这些结果:Rprof 带有多个 caveats。)