复杂的汇总功能 - 是否可以使用R data.table包解决?

时间:2014-01-08 06:35:54

标签: r data.table

我正在重写一些分析大量数据(大约1700万行)的R脚本,我想我会尝试使用data.table包来改善它的内存效率(我只是学习!)。

代码的一部分让我感到困惑。我不能发布我的原始解决方案,因为(1)它是废话(慢!),(2)它对数据非常微妙,并且会使这个问题复杂化。

相反,我已经制作了这个玩具示例(它确实是一个玩具示例):

ds <- data.table(ID=c(1,1,1,1,2,2,2,3,3,3),
Obs=c(1.5,2.5,0.0,1.25,1.45,1.5,2.5,0.0,1.25,1.45), 
Pos=c(1,3,5,6,2,3,5,2,3,4))

看起来像这样:

    ID  Obs Pos
 1:  1 1.50   1
 2:  1 2.50   3
 3:  1 0.00   5
 4:  1 1.25   6
 5:  2 1.45   2
 6:  2 1.50   3
 7:  2 2.50   5
 8:  3 0.00   2
 9:  3 1.25   3
10:  3 1.45   4

为了便于解释,我假装我们正在观察火车(每列火车都有自己的 ID ),穿过线性单向轨道,观察(某些值,不是关于在轨道上设定位置( pos ,这里是1-6)的列车的问题。预计火车不会使它成为整个轨道的长度(可能在它到达后6之前爆炸),有时观察者会错过观察......位置是连续的(因此,如果我们错过了观察4号位的火车,但我们在5号位观察到它,我们知道它必须通过位置4)。

从上面的data.table中,我需要生成一个这样的表:

   Pos Count
1:   1     3
2:   2     3
3:   3     3
4:   4     3
5:   5     2
6:   6     1

我的data.table ds中的每个唯一 Pos 的位置,无论是否观察,我都计算了在轨道上(或更远)进入该位置的列车数量是在赛道上的那个位置做的。

如果有人对如何解决这个问题有任何想法或建议,我们将不胜感激。不幸的是,我对data.table不太熟悉,知道是否可以这样做!或者它可能是一个非常简单的问题需要解决,我只是很慢:)

4 个答案:

答案 0 :(得分:14)

好问题!!示例数据构造得特别好,并得到了很好的解释。

首先我会展示这个答案,然后我将逐步解释。

> ids = 1:3   # or from the data: unique(ds$ID)
> pos = 1:6   # or from the data: unique(ds$Pos)
> setkey(ds,ID,Pos)

> ds[CJ(ids,pos), roll=-Inf, nomatch=0][, .N, by=Pos]
   Pos N
1:   1 3
2:   2 3
3:   3 3
4:   4 3
5:   5 2
6:   6 1
> 

这对你的大数据也应该非常有效。

一步一步

首先我尝试了交叉加入(CJ);即,每个位置的每列火车。

> ds[CJ(ids,pos)]
    ID Pos  Obs
 1:  1   1 1.50
 2:  1   2   NA
 3:  1   3 2.50
 4:  1   4   NA
 5:  1   5 0.00
 6:  1   6 1.25
 7:  2   1   NA
 8:  2   2 1.45
 9:  2   3 1.50
10:  2   4   NA
11:  2   5 2.50
12:  2   6   NA
13:  3   1   NA
14:  3   2 0.00
15:  3   3 1.25
16:  3   4 1.45
17:  3   5   NA
18:  3   6   NA

我看到每列火车有6排。我看到3列火车。我按照预期排了18行。我看到NA没有观察到那列火车。好。校验。交叉连接似乎正在起作用。我们现在构建查询。

如果列车在位置n处观察到它必须通过之前的位置,那么你写道。我马上想roll。我们来试试吧。

ds[CJ(ids,pos), roll=TRUE]
    ID Pos  Obs
 1:  1   1 1.50
 2:  1   2 1.50
 3:  1   3 2.50
 4:  1   4 2.50
 5:  1   5 0.00
 6:  1   6 1.25
 7:  2   1   NA
 8:  2   2 1.45
 9:  2   3 1.50
10:  2   4 1.50
11:  2   5 2.50
12:  2   6 2.50
13:  3   1   NA
14:  3   2 0.00
15:  3   3 1.25
16:  3   4 1.45
17:  3   5 1.45
18:  3   6 1.45

嗯。这推动了每列火车的观察结果。它为列车2和3留下了一些NA的位置,但你说如果在2号位置观察到列车,它必须通过位置1.它还将列车2和3的最后一次观察转到6号位置,但你说火车可能爆炸。所以,我们想倒退!那是roll=-Inf。这是一个复杂的-Inf,因为你也可以控制向后滚动,但我们不需要这个问题;我们只想无限期地倒退。让我们试试roll=-Inf,看看会发生什么。

> ds[CJ(ids,pos), roll=-Inf]
    ID Pos  Obs
 1:  1   1 1.50
 2:  1   2 2.50
 3:  1   3 2.50
 4:  1   4 0.00
 5:  1   5 0.00
 6:  1   6 1.25
 7:  2   1 1.45
 8:  2   2 1.45
 9:  2   3 1.50
10:  2   4 2.50
11:  2   5 2.50
12:  2   6   NA
13:  3   1 0.00
14:  3   2 0.00
15:  3   3 1.25
16:  3   4 1.45
17:  3   5   NA
18:  3   6   NA

那更好。差不多了。我们现在需要做的就是数数。但是,在火车2和3爆炸之后,那些讨厌的NA就在那里。让我们删除它们。

> ds[CJ(ids,pos), roll=-Inf, nomatch=0]
    ID Pos  Obs
 1:  1   1 1.50
 2:  1   2 2.50
 3:  1   3 2.50
 4:  1   4 0.00
 5:  1   5 0.00
 6:  1   6 1.25
 7:  2   1 1.45
 8:  2   2 1.45
 9:  2   3 1.50
10:  2   4 2.50
11:  2   5 2.50
12:  3   1 0.00
13:  3   2 0.00
14:  3   3 1.25
15:  3   4 1.45

顺便说一下,data.table尽可能地在单个DT[...]内,因为它是如何优化查询的。在内部,它不会创建NA然后删除它们;它从不首先创建NA。这个概念对提高效率很重要。

最后,我们所要做的就是数数。我们可以在最后将其作为复合查询来解决。

> ds[CJ(ids,pos), roll=-Inf, nomatch=0][, .N, by=Pos]
   Pos N
1:   1 3
2:   2 3
3:   3 3
4:   4 3
5:   5 2
6:   6 1

答案 1 :(得分:8)

data.table听起来像是一个很好的解决方案。从订购数据的方式来看,可以找到每列火车的最大值

maxPos = ds$Pos[!duplicated(ds$ID, fromLast=TRUE)]

然后将到达该位置的列车制成表格

nAtMax = tabulate(maxPos)

并计算每个位置的列车累计总和,从最后算起

rev(cumsum(rev(nAtMax)))
## [1] 3 3 3 3 2 1

我认为对于大数据来说这会非常快,但并不完全是内存效率。

答案 2 :(得分:3)

您可以尝试如下。我有目的地将它分成许多步骤解决方案,以便更好地理解。您可以将所有这些组合成一个步骤,只需链接[]

这里的逻辑是,首先我们找到每个ID的最终位置。然后我们汇总数据以查找每个最终位置的ID计数。由于最终排名6的所有ID也应计入最终排名5,我们使用cumsum将所有较高的ID计数添加到各自的较低ID。

ds2 <- ds[, list(FinalPos=max(Pos)), by=ID]

ds2 
##    ID FinalPos
## 1:  1        6
## 2:  2        5
## 3:  3        4

ds3 <- ds2[ , list(Count = length(ID)), by = FinalPos][order(FinalPos, decreasing=TRUE), list(FinalPos, Count = cumsum(Count))]

ds3
##    FinalPos Count
## 1:        4     3
## 2:        5     2
## 3:        6     1

setkey(ds3, FinalPos)

ds3[J(c(1:6)), roll = 'nearest']

##    FinalPos Count
## 1:        1     3
## 2:        2     3
## 3:        3     3
## 4:        4     3
## 5:        5     2
## 6:        6     1

答案 3 :(得分:1)

一些参考时间:

计时代码:

library(data.table)
set.seed(0L)
nr <- 2e7
nid <- 1e6
npos <- 20
ds <- unique(data.table(ID=sample(nid, nr, TRUE), Pos=sample(npos, nr, TRUE)))
# ds <- data.table(ID=c(1,1,1,1,2,2,2,3,3,3),
#     Obs=c(1.5,2.5,0.0,1.25,1.45,1.5,2.5,0.0,1.25,1.45),
#     Pos=c(1,3,5,6,2,3,5,2,3,4))
setkey(ds, ID, Pos)

ids = ds[, sort(unique(ID))]   # or from the data: unique(ds$ID)
pos = ds[, sort(unique(Pos))]   # or from the data: unique(ds$Pos)

mtd0 <- function() ds[CJ(ids, pos), roll=-Inf, nomatch=0][, .N, by=Pos]
mtd1 <- function() ds[,max(Pos),by=ID][,rev(cumsum(rev(tabulate(V1))))]
mtd2 <- function() ds[, .(Pos=1:Pos[.N]), ID][, .N, by=Pos]
bench::mark(mtd0(), mtd1(), mtd2(), check=FALSE)

identical(mtd0()$N, mtd2()$N)
#[1] TRUE

identical(mtd1(), mtd2()$N)
#[1] TRUE

时间:

# A tibble: 3 x 13
  expression      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result            memory               time     gc              
  <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list>            <list>               <list>   <list>          
1 mtd0()        2.14s    2.14s     0.468    1.26GB     1.40     1     3      2.14s <df[,2] [20 x 2]> <df[,3] [41 x 3]>    <bch:tm> <tibble [1 x 3]>
2 mtd1()     281.54ms 284.89ms     3.51   209.24MB     1.76     2     1   569.78ms <int [20]>        <df[,3] [24 x 3]>    <bch:tm> <tibble [2 x 3]>
3 mtd2()        1.63s    1.63s     0.613  785.65MB     7.35     1    12      1.63s <df[,2] [20 x 2]> <df[,3] [9,111 x 3]> <bch:tm> <tibble [1 x 3]>