在 data.table 中取列差异

Question

如何使用 data.table 语法生成 data.table，其中每一列都包含原始 data.table 的列与下一列之间的差异？

示例： 我有一个 data.table，其中每一行是一组，每一列是第 0 年、第 1、2 年等之后的幸存人口。如：

pop <- data.table(group_id = c(1, 2, 3), 
                   N = c(4588L, 4589L, 4589L), 
                   N_surv_1 = c(4213, 4243, 4264), 
                   N_surv_2 = c(3703, 3766, 3820), 
                   N_surv_3 = c(2953, 3054, 3159) )
# group_id    N N_surv_1 N_surv_2 N_surv_3
#        1 4588     4213     3703     2953
#        2 4589     4243     3766     3054
#        3 4589     4264     3820     3159

（数据类型不同，因为 N 是真正的整数计数，而 N_surv_1 等是可能是小数的投影。）

我所做的：使用基数diff和矩阵转置，我们可以：

diff <- data.table(t(diff(t(as.matrix(pop[,-1,with=FALSE])))))
setnames(diff, paste0("deaths_",1:ncol(diff)))
cbind(group_id = pop[,group_id],diff) 
# produces desired output:
#    group_id deaths_1 deaths_2 deaths_3
#           1     -375     -510     -750
#           2     -346     -477     -712
#           3     -325     -444     -661

我知道我可以在 melt.data.table 生成的单个列上按组使用基础 diff，所以这可行但不漂亮：

melt(pop, 
     id.vars = "group_id"
     )[order(group_id)][, setNames(as.list(diff(value)),
                                   paste0("deaths_",1:(ncol(pop)-2)) ),
                          keyby = group_id]

这是最 data.table-riffic 的方法吗，或者有没有办法在 data.table 中将其作为多列操作来完成？

Answer 1

在不重塑数据的情况下，每行都有一个唯一的id，你可以按id列分组，然后用diff计算每行的差异，即unlist(.SD):

pop[, setNames(as.list(diff(unlist(.SD))), paste0("deaths_", 1:(ncol(pop)-2))), group_id]

#    group_id deaths_1 deaths_2 deaths_3
# 1:        1     -375     -510     -750
# 2:        2     -346     -477     -712
# 3:        3     -325     -444     -661

本质上，如果您忽略设置列名，就会像这样：

pop[, as.list(diff(unlist(.SD))), group_id]

Answer 2

嗯，你可以减去子集：

ncols = grep("^N(_surv_[0-9]+)?", names(pop), value=TRUE)
pop[, Map(
  `-`, 
   utils:::tail.default(.SD, -1), 
   utils:::head.default(.SD, -1)
), .SDcols=ncols]

#    N_surv_1 N_surv_2 N_surv_3
# 1:     -375     -510     -750
# 2:     -346     -477     -712
# 3:     -325     -444     -661

您可以使用 := 将这些值分配给新列。我不知道为什么 tail 和 head 没有更容易获得...正如@akrun 所指出的，您可以使用 with=FALSE 代替，例如 pop[, .SD[, -1, with=FALSE] - .SD[, -ncol(.SD), with=FALSE], .SDcols=ncols].

无论如何，与简单的重塑相比，这相当复杂：

melt(pop, id="group_id")[, tail(value, -1) - head(value, -1), by=group_id]
#    group_id   V1
# 1:        1 -375
# 2:        1 -510
# 3:        1 -750
# 4:        2 -346
# 5:        2 -477
# 6:        2 -712
# 7:        3 -325
# 8:        3 -444
# 9:        3 -661

Answer 3

这是另一种无需重塑或分组的方法，可能使其更快。如果它的行数很少，那么它可能不会有明显的差异。

cols<-names(pop)[-1]
combs<-list()
for(i in 2:length(cols)) {
  combs[[length(combs)+1]]<-c(cols[i-1], cols[i])
}
newnames<-sapply(combs,function(x) gsub('N_surv','death',x[2]))
deathpop<-copy(pop)
deathpop[,(newnames):=lapply(combs,function(x) get(x[2])-get(x[1]))]
deathpop[,(cols):=NULL]

我做了一些基准测试

rows<-10000000
pop <- data.table(group_id = 1:rows, 
                  N = runif(rows,3000,4000), 
                  N_surv_1 = runif(rows,3000,4000), 
                  N_surv_2 = runif(rows,3000,4000), 
                  N_surv_3 = runif(rows,3000,4000))
system.time({
    cols<-names(pop)[-1]
    combs<-list()
    for(i in 2:length(cols)) {
      combs[[length(combs)+1]]<-c(cols[i-1], cols[i])
    }
    newnames<-sapply(combs,function(x) gsub('N_surv','death',x[2]))
    deathpop<-copy(pop)
    deathpop[,(newnames):=lapply(combs,function(x) get(x[2])-get(x[1]))]
    deathpop[,(cols):=NULL]})

它返回了

user  system elapsed 
0.192   0.808   1.003

相比之下我做到了

system.time(pop[, as.list(diff(unlist(.SD))), group_id])

它返回了

   user  system elapsed 
169.836   0.428 170.469

我也做了

system.time({
  ncols = grep("^N(_surv_[0-9]+)?", names(pop), value=TRUE)
  pop[, Map(
    `-`, 
    utils:::tail.default(.SD, -1), 
    utils:::head.default(.SD, -1)
  ), .SDcols=ncols]
})

返回

 user  system elapsed 
0.044   0.044   0.089

最后，做

system.time(melt(pop, id="group_id")[, tail(value, -1) - head(value, -1), by=group_id])

returns

   user  system elapsed 
223.360   1.736 225.315

Frank 的 Map 解决方案是最快的。如果你把我的副本拿走，那么它会更接近弗兰克的时间，但他仍然赢得了这个测试用例。

在 data.table 中取列差异

Take column-wise differences across a data.table

r

difference

data.table