更新

Question

我有一些我试图合并的大型数据集。我已经创建了一个我想做的玩具示例。我有三张桌子：

require(data.table)
set.seed(151)
x <- data.table(a=1:100000)
y <- data.table(b=letters[1:20],c=sample(LETTERS[1:4]))
proportion <- data.table(expand.grid(a=1:100000,c=LETTERS[1:4]))
proportion[,prop:=rgamma(4,shape = 1),by=a]
proportion[,prop:=prop/sum(prop),by=a]

这三个表格为x，y和proportion。对于x中的每个元素，我想使用表y中的概率从整个表proportion中进行抽样，并将它们组合到另一个表中。我想出的方法是：

temp <- setkey(setkey(x[,c(k=1,.SD)],k)[y[,c(k=1,.SD)],allow.cartesian=TRUE][,k:=NULL],a,c)
temp <- temp[setkey(proportion,a,c)][,prop:=prop/.N,by=.(a,c)] # Uniform distribution within the same 'c' column group
chosen_pairs <- temp[,.SD[sample(.N,5,replace=FALSE,prob = prop)],by=a]

但是这种方法是内存密集型并且速度慢，因为它首先交叉连接两个表然后从中进行采样。有没有办法以有效（记忆和时间）的方式执行此任务？

Answer 1

我在this问题中遇到了类似的问题。我将您的解决方案包装成功能以便更好地进行比较：

goreF <- function(x,y,proportion){
  temp <- setkey(setkey(x[, c(k = 1, .SD)], k)[y[,c(k = 1, .SD)],
                                    allow.cartesian = TRUE][, k := NULL],
           a, c)
  temp <- temp[setkey(proportion, a, c)][, prop := prop / .N, by = .(a, c)]
  chosen_pairs <- temp[, .SD[sample(.N, 5, replace = FALSE, prob = prop)],
                   by = a]
  chosen_pairs
}

我的方法：

myFunction <- function(x, y, proportion){
  temp <- setkey(setkey(x[, c(k = 1, .SD)], k)[y[,c(k = 1, .SD)],
                                           allow.cartesian = TRUE][, k := NULL],
             a, c)
  temp <- temp[setkey(proportion, a, c)][, prop := prop / .N, by = .(a, c)]
  chosen_pairs <- temp[, sample(.I, 5, replace = FALSE, prob = prop), by = a]
  indexes <- chosen_pairs[[2]]
  temp[indexes]
}

require(rbenchmark)
benchmark(myFunction(x, y, proportion), goreF(x, y, proportion),
      replications = 1,
      columns = c("test", "replications", "elapsed", "relative",
                  "user.self", "sys.self"))
                          test replications elapsed relative user.self sys.self
2      goreF(x, y, proportion)            1   19.83   21.323     19.35     0.13
1 myFunction(x, y, proportion)            1    0.93    1.000      0.86     0.08

也许可以找到更多改进，如果发现任何改进，我会更新。前两个操作似乎太复杂了，也许它们可以缩短，但是，由于我没有看到它们影响计算时间，我没有重写它们。

更新

正如我在开头提到的问题所指出的那样，如果您的群组只包含一个元素，则可能会遇到myFunction的问题。所以我根据该帖子的评论对其进行了修改。

myFunction2 <- function(x, y, proportion){
  temp <- setkey(setkey(x[, c(k = 1, .SD)], k)[y[,c(k = 1, .SD)],
                                               allow.cartesian = TRUE][, k := NULL],
                 a, c)
  temp <- temp[setkey(proportion, a, c)][, prop := prop / .N, by = .(a, c)]
  indexes <- temp[, .I[sample(.N, 5, replace = T, prob = prop)], by = a]
  indexes <- indexes[[2]]
  temp[indexes]
}

benchmark(myFunction(x, y, proportion), myFunction2(x, y, proportion),
          replications = 5,
          columns = c("test", "replications", "elapsed", "relative",
                      "user.self", "sys.self"))

                           test replications elapsed relative user.self sys.self
1  myFunction(x, y, proportion)            5    6.61    1.064      6.23     0.36
2 myFunction2(x, y, proportion)            5    6.21    1.000      5.71     0.26

我们可以看到边际速度的提升。

通过抽样加入data.table

1 个答案:

更新