r - 在大型 data.table 中按 .N 对多列进行子集化

Question

我有一个包含数百万行和 30 列的大型 data.table。这些列包含不同数量的分类特征。我想删除所有出现次数少于特定比例的特征。

这是一个例子:

dt <- data.table(id=1:18,col1=c(rep("a",5), rep("b",10), rep("c",3)), col2=c(rep("d",12),rep("e",5),"f"))
dt
    id col1 col2
 1:  1    a    d
 2:  2    a    d
 3:  3    a    d
 4:  4    a    d
 5:  5    a    d
 6:  6    b    d
 7:  7    b    d
 8:  8    b    d
 9:  9    b    d
10: 10    b    d
11: 11    b    d
12: 12    b    d
13: 13    b    e
14: 14    b    e
15: 15    b    e
16: 16    c    e
17: 17    c    e
18: 18    c    f

例如，我只想保留每列出现比例超过 0.5 的特征:

> dt[,.N,by=col1][N/sum(N)>0.5]
   col1  N
1:    b 10

和

> dt[,.N,by=col2][N/sum(N)>0.5]
   col2  N
1:    d 12

我采用的方法是遍历列并使用 %in%

for (i in 1:2) dt[, paste0('newcol',i) :=lapply(dt[[paste0('col',i)]],
 function(y) ifelse(y %in% dt[,.N,by=dt[[paste0('col',i)]]][N/sum(N)>0.5][[1]],y,"") )]

然后我创建一个新列来保存合并值 dt[, merge := paste(newcol1,newcol2), by=id]这让我在 merge 列中得到了我想要的输出:

> dt
    id col1 col2 newcol1 newcol2 merge
 1:  1    a    d               d     d
 2:  2    a    d               d     d
 3:  3    a    d               d     d
 4:  4    a    d               d     d
 5:  5    a    d               d     d
 6:  6    b    d       b       d   b d
 7:  7    b    d       b       d   b d
 8:  8    b    d       b       d   b d
 9:  9    b    d       b       d   b d
10: 10    b    d       b       d   b d
11: 11    b    d       b       d   b d
12: 12    b    d       b       d   b d
13: 13    b    e       b            b 
14: 14    b    e       b            b 
15: 15    b    e       b            b 
16: 16    c    e                      
17: 17    c    e                      
18: 18    c    f         

问题在于，这在大型数据集上确实慢。我怀疑我没有以“data.table-y”的方式处理这个问题。我还必须非常小心不要复制原始数据集，因为它几乎不适合我的 RAM，这就是 data.table 首先如此吸引人的原因。不过，我不在乎是否有任何中间步骤，只要过程更快即可。

> sessionInfo()
R version 3.0.2 (2013-09-25)
Platform: x86_64-apple-darwin10.8.0 (64-bit)

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] data.table_1.9.2

loaded via a namespace (and not attached):
[1] plyr_1.8.1    Rcpp_0.11.2   reshape2_1.4  stringr_0.6.2 tools_3.0.2 

Answer 1

希望这次我做对了。太多时间浪费在错误的答案上!

cols = paste("col", 1:2, sep="")
rows = nrow(dt)
for (i in seq_along(cols)) {
    dt[, (cols[i]) := if (.N/rows <= .5) "", by=c(cols[i])]
}
dt[, merge := do.call(paste, c(as.list(dt)[-1L], sep= " "))]

---

这是 1e6 * 30 列的基准:

set.seed(1L)
dt = setDT(lapply(1:30, function(x) sample(letters[1:4], 1e6, TRUE)))
system.time({
    cols = paste("V", 1:30, sep="")
    rows = nrow(dt)
    for (i in seq_along(cols)) {
        dt[, (cols[i]) := if (.N/rows <= .5) "", by=c(cols[i])]
    }
    dt[, merge := do.call(paste, c(as.list(dt)[-1L], sep= " "))]
})
#  user  system elapsed 
# 4.880   0.086   5.095 

我会让您选择任何可能的进一步优化。祝你好运!