Memory 在 R 中使用 sapply() 的有效方法

Question

I am trying to reduce the memory consumption of a piece of R code I have been working on. I am using the peakRAM() function to measure the maximum RAM used. It is a long code and there is a simple sapply() function at the end of it. I figured out that it is the sapply() part which is consuming the maximum memory. So I have written a small function fun1() imitating the objects and the sapply() function from that part of my code, which is as follows:

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())

If you run this in R, you get a peakRAM() consumption of around 330Mb. But you can see that the two objects tm and r are both of very small size (2Kb and 1.6Mb respectively) and if you look at the peakRAM() for computing a single colSums(tm[1:200,]) , it is very small, like 0.1Mb. So it feels like, during sapply() , R is probably not getting rid of the memory while looping over 1:20000 . Otherwise, since a single colSums(tm[1:200,]) takes very small memory, and all the objects associated are of small memory, the sapply() should have taken small memory.

In this regard, I already know that R has a gc() function which gets rid of unnecessary memory when needed and probably R is not clearing memory during sapply() which is resulting into this high memory consumption. If that is true, I would like to know if there is a way to get rid of this and complete the job without requiring this much extra memory? Note that, I do not wish to compromise on the run-time for doing that.

Answer 1

Here is your function modified to use vapply instead of sapply and .colSums instead of colSums :

f1 <- function(x, l) {
    d <- dim(x)
    m <- d[1L]
    n <- d[2L]
    FUN <- function(i) .colSums(x[i, , drop = FALSE], m, n)
    vapply(l, FUN, double(n))
}

Here is a C implementation, made accessible to R via the inline package:

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], n = d[1], N = length(l);

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

SEXP index;
R_xlen_t nindex;
int *pindex;

double sum;

for (int i = 0, rpos = 0; i < N; ++i)
{
    index = VECTOR_ELT(l, i);
    nindex = xlength(index);
    pindex = INTEGER(index);
    for (int xpos = 0; xpos < nx; xpos += m, ++rpos)
    {
        sum = 0.0;
        for (int 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")

And here is a test showing that f1 and f2 give identical results, where I have used a 300-by-10 double matrix and a length-20000 list of length-200 index vectors:

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

If you profile f1(x, l) and f2(x, l) using Rprof and summaryRprof (or maybe your peakRAM , though I've never used it), then you will find that f2 is both faster and more efficient.

Note that I've only used the R API in my C code. You may find Rcpp to be more approachable, in which case you are encouraged to implement a C++ equivalent to my f2 based on Rcpp .