通过更改组加快轻拍速度

Question

我正在写一个函数来计算两组平均值的差异，但是组实际上每次都在变化，得到结果很简单，但问题是我有一个相当大的数据集，所以速度是钥匙。这是“可读”版本，以虹膜数据为例。

loopDif = function(Nsim) {
  change = numeric(Nsim)
  var = iris$Sepal.Length
  for (i in 1:Nsim){
    randomSpecies = sample(c("A","B"), length(var), replace=TRUE)
    change[i]  =  diff(tapply(var,  randomSpecies,  mean))
  }
  return(change)
}

> system.time(loopDif(10000))
   user  system elapsed 
   2.06    0.00    2.06 

我尝试将代码矢量化：

slowDif <- function(Nsim) {
  change = numeric(Nsim)
  randomSpecies = replicate(Nsim,sample(c("A","B"), length(var), replace=TRUE))
  var = iris$Sepal.Length
  change = diff(unlist(lapply(split(randomSpecies, col(randomSpecies)), 
                             function(x) unlist(lapply(split(var, x), mean)))))
  return(change)
}

> system.time(slowDif(10000))
   user  system elapsed 
   1.42    0.00    1.42

现在快了，但还是不够快，希望能做到1秒以下，甚至0.75秒。我对时间如此着迷的原因是因为我有一个截止日期，但我当前的代码还不够快。

我还尝试了分析，它告诉我 unlist(lapply()) 部分是瓶颈，但我不知道如何重写它。

如果有人可以为我提供替代方案，即使只是建议，我真的很感激。谢谢。

Answer 1

试试这个：

loopDif2 <- function(Nsim) {
    change <- numeric(Nsim)
    var <- iris$Sepal.Length
    nAgroup<-rbinom(Nsim,length(var),0.5)
    tot<-sum(var)
    for (i in 1:Nsim){
      change[i]<-sum(var[sample(length(var),nAgroup[i])])
    }
    change/nAgroup-(tot-change)/(length(var)-nAgroup)
}

在文字中：我首先提取A 组的元素数量，保持B 组隐含。然后我在每次迭代中提取A 组的索引。我评估总和并除以元素的数量以获得平均值。另一个总和显然是变量的总和减去A 组的总和。然后评估B 组的平均值。

在我的电脑上的性能：

system.time(loopDif(10000))
# user  system elapsed 
#3.855   0.004   3.867 
system.time(loopDif2(10000))
# user  system elapsed 
#0.139   0.000   0.139