R数据表：计算分组频率

我正在尝试向data.table中添加列，这些列本质上是为聚合的每个组附加一个累积频率表。不幸的是，我目前的解决方案比我希望的慢了十倍

以下是我使用的（为难看的一行道歉）：

如果箱子边界设置为

0,25,50,75100

，我希望我的表格如下所示：

id category colx bin1 bin2 bin3 bin4
1  a        5    1    2    2    3
2  a        30   1    2    2    3
3  b        21   1    2    3    4
4  c        62   0    1    3    3
5  b        36   1    2    3    4
6  a        92   1    2    2    3
7  c        60   0    1    3    3
8  b        79   1    2    3    4
9  b        54   1    2    3    4
10 c        27   0    1    3    3

---

在实际的数据集中，我使用4个不同的列进行分组，有数百万行和唯一的组。当我尝试一个更简单的函数时，例如

sum

，计算所需的时间是可以接受的。有什么方法可以显著加快计数过程吗？

好的，这里有一种方法（这里我使用

data.table v1.9.3

）。删除

by=.EACHI

如果您使用的是版本

您的解决方案在9秒内完成了我花20分钟完成的工作。你对效率的差异有什么好的认识吗？另外，我也不清楚为什么要使用交叉连接。我使用dt[，.N，by=“x，y，ival”]定义了ans。你选择交叉连接有什么原因吗？
id category colx bin1 bin2 bin3 bin4
1  a        5    1    2    2    3
2  a        30   1    2    2    3
3  b        21   1    2    3    4
4  c        62   0    1    3    3
5  b        36   1    2    3    4
6  a        92   1    2    2    3
7  c        60   0    1    3    3
8  b        79   1    2    3    4
9  b        54   1    2    3    4
10 c        27   0    1    3    3

dt[, ival := findInterval(colx, seq(0, 100, by=25), rightmost.closed=TRUE)]
setkey(dt, category, ival)
ans <- dt[CJ(unique(category), unique(ival)), .N, allow.cartesian=TRUE, by=.EACHI]
ans[, N := cumsum(N), by="category"][, bin := "bin"]
ans <- dcast.data.table(ans, category ~ bin+ival, value.var="N")
ans <- dt[ans][, ival := NULL]

    id category colx bin_1 bin_2 bin_3 bin_4
 1:  1        a    5     1     2     2     3
 2:  2        a   30     1     2     2     3
 3:  6        a   92     1     2     2     3
 4:  3        b   21     1     2     3     4
 5:  5        b   36     1     2     3     4
 6:  9        b   54     1     2     3     4
 7:  8        b   79     1     2     3     4
 8: 10        c   27     0     1     3     3
 9:  4        c   62     0     1     3     3
10:  7        c   60     0     1     3     3

K = 1e3L
N = 20e6L
sim_data <- function(K, N) {
    set.seed(1L)
    ff <- function(K, N) sample(paste0("V", 1:K), N, TRUE)
    data.table(x=ff(K,N), y=ff(K,N), val=sample(1:100, N, TRUE))
}

dt <- sim_data(K, N)
method1 <- function(x) { 
    dt[, ival := findInterval(val, seq(0, 100, by=25), rightmost.closed=TRUE)]
    setkey(dt, x, y, ival)
    ans <- dt[CJ(unique(x), unique(y), unique(ival)), .N, allow.cartesian=TRUE, by=.EACHI]
    ans[, N := cumsum(N), by="x,y"][, bin := "bin"]
    ans <- dcast.data.table(ans, x+y ~ bin+ival, value.var="N")
    ans <- dt[ans][, ival := NULL]
}

system.time(ans1 <- method1(dt))
#   user  system elapsed 
# 13.148   2.778  16.209 

dt <- sim_data(K, N)
method2 <- function(x) {
    ivals = seq(24L, 100L, by=25L)
    ivals[length(ivals)] = 100L
    setkey(dt, x,y,val)
    dt[, ival := seq_len(.N), by="x,y"]
    ans <- dt[CJ(unique(x), unique(y), ivals), roll=TRUE, mult="last"][is.na(ival), ival := 0L][, bin := "bin"]
    ans <- dcast.data.table(ans, x+y~bin+val, value.var="ival")
    dt[, ival := NULL]
    ans2 <- dt[ans]
}

system.time(ans2 <- method2(dt))
#   user  system elapsed 
# 12.538   2.649  16.079 

## check if both methods give identical results:

setkey(ans1, x,y,val)
setnames(ans2, copy(names(ans1)))
setkey(ans2, x,y,val)

identical(ans1, ans2) # [1] TRUE