在 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 的消耗。但是您可以看到 tm
和 r
这两个对象的大小都非常小(分别为 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,您可能会发现它更容易理解。
这是一个显示 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 内存——这或多或少等于 return 值的大小。 (请谨慎解读这些结果:Rprof
带有多个 caveats。)
我正在尝试减少我一直在处理的一段 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),如果您查看 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,您可能会发现它更容易理解。
这是一个显示 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 内存——这或多或少等于 return 值的大小。 (请谨慎解读这些结果:Rprof
带有多个 caveats。)