在R中，使用sapply()的内存有效方法。

Question

在R中，使用sapply()的内存有效方法。

3

我试图减少一段我一直在使用的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。但是可以看到两个对象 tm 和

 r 都非常小（分别为2Kb和1.6Mb），如果查看计算单个 colSums（tm [1:200，]）的 peakRAM（），则非常小，例如0.1Mb。 因此，在 sapply()期间，R可能没有在循环变量 1:20000 上处理内存。否则，由于单个 colSums（tm [1:200，]）需要的内存非常小，并且所有相关对象的内存也很小， sapply()应该只占用少量内存。
在这方面，我已经知道R有一个 gc()函数，可以在需要时清除不必要的内存，并且可能在 sapply()期间R未清除内存，这导致了高内存消耗。 如果是这样，请告诉我是否有一种方法可以摆脱这种情况并在不需要这么多额外内存的情况下完成工作？ 请注意，我不希望在运行时间上妥协。

- slowowl

2

每个子集操作都需要进行内存分配，并且垃圾不能立即被回收。当您用tm替换tm[1:200，]时，请注意内存使用量显着下降。在没有更多关于您要做什么的信息的情况下，很难说R中是否有一种更有效的方法，但您可以考虑用等效的vapply调用替换sapply调用。最终，这样的任务最好在C中进行优化... - Mikael Jagan

@MikaelJagan 感谢您指出这一点。我已经注意到使用 tm 可以大大减少内存使用量，但不幸的是，我需要对我的代码进行子集操作。我有一个长度为 20,000 的列表，其第 i 个元素是长度约为 200 的向量，在 sapply() 的第 i 次迭代中，我正在对该向量中的行进行子集操作，而不是示例代码中的 1:200。关于使用 C，您认为在此处实现 sapply() 代码的 Rcpp 实现可以解决问题吗？ - slowowl

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Mikael Jagan · Accepted Answer

这是您的函数，经过修改使用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。您可以使用Rcpp API编写等效的C++代码，您可能会发现更易于理解。

以下是测试，显示f1和f2给出了相同的结果：

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的内存，这大致是返回值的大小。（请谨慎解释这些结果：Rprof带有一些caveats。）