增强数据帧模拟性能

Question

编码时，我通常只编码脑海中出现的内容。虽然我认为我从一开始就学会了高效的 R 编码（例如避免 for ... if 循环），但我的解决方案并不总是真正由性能驱动。不幸的是，有时了解什么是最有效的代码可能变得至关重要 - 我想学习它！

目前我正在模拟多个数据框组合成一个列表。模拟之后，我需要第二个数据框，其中包含整个列表中所有列的均值和标准差。 (这里的'Simulation'意味着一些变量是来自其他数据框的simulated/resampled，其他变量只是具有特定b_0的随机正态或二项分布值。为了为简洁起见，我在这里省去了重新采样的第一部分。）

我的代码（参见下面的示例）完美地产生了预期的结果，但它似乎首先有点慢（我说的是真实情况下的几个小时），其次，内存消耗很高（对于我暂时减少了列表中模拟 dfs 的数量）。

对于模拟，我知道在函数中定义一个 data.frame 可能是个问题，但我不知道如何做得更好。对于 mean/SD 数据框，我只能说它更慢。

如何提高代码的性能？有没有大神可以补充提供一些关于这种性能提升的基本规则（或相关信息来源）？

（我正在使用 R 3。x/64 和 Win 7/64 AMD FX(tm)-8350 八核处理器，4 GHz，16 GB 机器。CPU 运行时保持相当凉爽，RAM 呻吟在它的极限。）

这里我在评论中给出了一个示例代码，其中包含测量的系统时间：

# definitions
r <- 1e5 # number of rows
n <- 1e3 # number of dfs

# simulation of the list  
library(dplyr)
system.time(list <- lapply(1:n, function(i){       # 59.05 sec
  data.frame(a = rbinom(r, 1, .375)) %>%
    mutate(
      b = rnorm(r, 0, 2),
      c = .42 * rnorm(r, 0, 6),
      d = rbinom(r, 11, c(1:11)/11),
      e = rbinom(r, 1, .1),
      f = .02 * rnorm(r, 0, 5))
}))

# df w/ means & sds
system.time(list.s <- data.frame(                  # 73.20 sec
  list.mean = round(rowMeans(sapply(list, colMeans)), 2),
  list.sd = round(sapply(do.call(rbind, list), sd), 2)))

Answer 1

扩展 Rolands 评论，您可以预先创建大量人口数据，然后简单地为每个 'sample'/ 迭代对其进行子集化。示例：

## create large population data:

s <- 1e6 # probably big enough for this problem
set.seed(12)
d <- matrix(NA, nrow = s, ncol = 6) #..
# using matrix is more efficient than data.frame
d[,1] <- rbinom(s, 1, .375)
d[,2] <- rnorm(s, 0, 2)
d[,3] <- .42 * rnorm(s, 0, 6)
d[,4] <- rbinom(s, 11, c(1:11)/11)
d[,5] <- rbinom(s, 1, .1)
d[,6] <- .02 * rnorm(s, 0, 5)
head(d)
#      [,1]        [,2]      [,3] [,4] [,5]        [,6]
# [1,]    0  0.73853351  1.097805    1    0 -0.06233008
# [2,]    1 -0.05311206  4.447807    2    0 -0.01117972
# [3,]    1  1.71576276 -3.619708    6    0  0.02962562
# [4,]    0  1.92188205 -1.062585    2    0  0.03195146
# [5,]    0 -1.41097404  1.706067    2    0 -0.07751285
# [6,]    0  4.19130890  2.663374    8    0 -0.02316172


r <- 1e4 # number of rows
n <- 1e2 # number of dfs

si <- replicate(n, sample.int(s, r)) # get indexes for each sample 

# loop trougth samples and subset data:
nSamples <- lapply(1:n, function(x) {
  d[si[, x],]
  })

# and calculate colMeans:
list.mean2 = round(rowMeans(sapply(nSamples, colMeans)), 3)
list.mean2
# [1]  0.376  0.000 -0.003  5.999  0.100  0.000

与您的结果进行比较：

require(dplyr)
list1 <- lapply(1:n, function(i){
  data.frame(a = rbinom(r, 1, .375)) %>%
    mutate(
      b = rnorm(r, 0, 2),
      c = .42 * rnorm(r, 0, 6),
      d = rbinom(r, 11, c(1:11)/11),
      e = rbinom(r, 1, .1),
      f = .02 * rnorm(r, 0, 5))
})

list.mean1 = round(rowMeans(sapply(list1, colMeans)), 3)
list.mean1
# a      b      c      d      e      f 
# 0.375 -0.002  0.004  6.001  0.100  0.000

我们可以看到，对于这个小的 n 值，均值的估计值非常相似。

P.S。因为 'list' 是基本 R 函数，你不应该用那个名字命名变量！

让我们将这两种方法包装到函数中以测试时序：

mySim <- function(s, r, n) {
  d <- matrix(NA, nrow = s, ncol = 6)
  d[,1] <- rbinom(s, 1, .375)
  d[,2] <- rnorm(s, 0, 2)
  d[,3] <- .42 * rnorm(s, 0, 6)
  d[,4] <- rbinom(s, 11, c(1:11)/11)
  d[,5] <- rbinom(s, 1, .1)
  d[,6] <- .02 * rnorm(s, 0, 5)
  si <- lapply(1:n, function(x) sample.int(s, r))
  nSamples <- lapply(si, function(x) {
    d[x,]
  })
  list.mean2 = rowMeans(sapply(nSamples, colMeans))
  list.mean2
}

yourSim <- function(r, n) {
  require(dplyr)
  list1 <- lapply(1:n, function(i){
    data.frame(a = rbinom(r, 1, .375)) %>%
      mutate(
        b = rnorm(r, 0, 2),
        c = .42 * rnorm(r, 0, 6),
        d = rbinom(r, 11, c(1:11)/11),
        e = rbinom(r, 1, .1),
        f = .02 * rnorm(r, 0, 5))
  })
  list.mean1 = rowMeans(sapply(list1, colMeans))
  list.mean1
}

system.time(mySim(1e6, 1e4, 1e2)) # ~ 0.6 sek
system.time(yourSim(1e4, 1e2)) # ~ 1.5 sek

# if s = 1e7 :
system.time(mySim(1e7, 1e4, 1e2)) # ~ 4.53 sek

我们可以看到，为较小的 n 和 r 值创建大量人口数据并没有提高速度。

让我们把s当作1e6（100万），但你应该自己调查一下是否足够了。

如果我们比较更大的 'r' 和 'n' 值的时间：

system.time(r1 <- mySim(1e6, 1e5, 1e3)) # ~ 20 sek
system.time(r2 <- yourSim(1e5, 1e3)) # ~ 60 sek

round(r1, 3)
# [1]  0.376 -0.003 -0.002  6.001  0.100  0.00
round(r2, 3)
# a     b     c     d     e     f 
# 0.375 0.000 0.000 6.000 0.100 0.000

关于计算标准差：也许您想使用包 'matrixStats'?

中的 'rowSds()' 或 'colSds()'

此外，我建议您研究一下 Rcpp 包，这可能有助于进一步加快代码速度。

增强数据帧模拟性能

Enhance performance in simulation of data frames

simulation

performance

r

resampling