我正在重写一些分析大量数据(大约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不太熟悉,知道是否可以这样做!或者它可能是一个非常简单的问题需要解决,我只是很慢:)
答案 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]>