R-使采样速度更快

Question

我需要从2300万数据集中提取2Mil观测值。使用下面的代码需要大量时间才能完成。在带有16GB RAM的Xeon CPU上，它仍在12小时后运行。我还注意到CPU的运行量仅为25％，HD为43％。如何使采样过程更快地运行？附件是我正在使用的两行代码

prb <- ifelse(dat$target=='1', 1.0, 0.05)
smpl <- dat[sample(nrow(dat), 2000000, prob = prb), ]

Answer 1

sample函数以不平等的概率调用，并且使用 replace = FALSE，可能并不完全做您想做的事情：它绘制一个样本，然后重新计算剩余的概率，以便它们加起来一个人，然后绘制一个额外的样本，等等。这是缓慢的，并且概率不再匹配原件。

一个解决方案，在您的情况下，将数据集分为两个（target =='1'and target！='1'），并为每个数据计算单独的样本。您只需要计算每个组中要选择多少个元素即可。

另一个解决方案是使用sampling软件包中的采样方法。例如，系统抽样：

library(sampling)
nsample <- 2E6
# Scale probabilities: add up to the number of elements we want
prb <- nsample/sum(prb) * prb
# Sample
smpl <- UPrandomsystematic(prb)

这在我的系统上大约需要3秒钟。

检查输出：

> t <- table(smpl, prb)
> sum(smpl)
[1] 2e+06
> t[2,2]/t[2,1]
[1] 19.96854

我们确实选择了2E6记录，并且target == 1的包含概率比target != 1小20倍。

Answer 2

瓶颈来自采样，如Jan van der Laan所述。

当您需要采样而无需替换时（当大小比初始尺寸小的5倍时）时，请拒绝。您可以用替换品进行样品两倍的替换数量，并且仅占用第一个唯一值的数量。

N <- 23e6
dat <- data.frame(
  target = sample(0:1, size = N, replace = TRUE),
  x = rnorm(N)
)      
prb <- ifelse(dat$target == 1, 1.0, 0.05)
n <- 2e6
Rcpp::sourceCpp('sample-fast.cpp')
sample_fast <- function(n, prb) {
  N <- length(prb)
  sample_more <- sample.int(N, size = 2 * n, prob = prb, replace = TRUE)
  get_first_unique(sample_more, N, n)
}

其中'sample-fast.cpp'包含

#include <Rcpp.h>
using namespace Rcpp;

// [[Rcpp::export]]
IntegerVector get_first_unique(const IntegerVector& ind_sample, int N, int n) {
  LogicalVector is_chosen(N);
  IntegerVector ind_chosen(n);
  int i, k, ind;
  for (k = 0, i = 0; i < n; i++) {
    do {
      ind = ind_sample[k++];
    } while (is_chosen[ind-1]);
    is_chosen[ind-1] = true;
    ind_chosen[i] = ind;
  }
  return ind_chosen;
}

然后您得到：

system.time(ind <- sample_fast(n, prb))

不到1秒钟。

Answer 3

r构建是一次仅使用单个CPU核心。运行代码多线程的最简单方法是Microsoft R打开。我不确定它是否也可以改善抽样的性能，但值得一试。如果不是，则多核软件包，例如 Parallel 或 Multicore 可能会为您带来技巧。问题在于，多个内核仅在某些类型的操作上起作用。

我不能对您的代码本身说太多，因为它不包含可再现的示例。