hel*_*ter 3 r binary-data programmatically-created data.table
我有一个很大的(1200万行)data.table,看起来像这样:
library(data.table)
set.seed(123)
dt <- data.table(id=rep(1:3, each=5),y=sample(letters[1:5],15,replace = T))
> dt
id y
1: 1 b
2: 1 d
3: 1 c
4: 1 e
5: 1 e
6: 2 a
7: 2 c
8: 2 e
9: 2 c
10: 2 c
11: 3 e
12: 3 c
13: 3 d
14: 3 c
15: 3 a
Run Code Online (Sandbox Code Playgroud)
我想创建一个新的data.table包含我的变量id(这将是这个新的独特的键data.table)和其他5个二元变量每一个对应于每个类别的y内搭的值1,如果ID对于该值y,0否则.
输出data.table应如下所示:
id a b c d e
1: 1 0 1 1 1 1
2: 2 1 0 1 0 1
3: 3 1 0 1 1 1
Run Code Online (Sandbox Code Playgroud)
我尝试在循环中执行此操作,但它很慢,而且我不知道如何以编程方式传递二进制变量名称,因为它们依赖于我试图"拆分"的变量.
编辑:正如@mtoto所指出的,这里已经提出并回答了类似的问题,但解决方案是使用该reshape2软件包.
我想知道是否有另一种(更快)方法可以通过:=在data.table中使用运算符来实现,因为我有一个庞大的数据集,而且我正在使用这个包很多.
EDIT2:@ Arun在我的数据上的帖子中的函数基准(~1200万行,~350万个不同的id和y变量的490个不同标签(导致490个虚拟变量)):
system.time(ans1 <- AnsFunction()) # 194s
system.time(ans2 <- dcastFunction()) # 55s
system.time(ans3 <- TableFunction()) # Takes forever and blocked my PC
Run Code Online (Sandbox Code Playgroud)
data.tabledcast使用data.table的内部结构有自己的实现,应该很快.尝试一下:
dcast(dt, id ~ y, fun.aggregate = function(x) 1L, fill=0L)
# id a b c d e
# 1: 1 0 1 1 1 1
# 2: 2 1 0 1 0 1
# 3: 3 1 0 1 1 1
Run Code Online (Sandbox Code Playgroud)
只是想到另一种处理方法,通过引用预分配和更新(也许dcast的逻辑应该这样做,以避免中间体).
ans = data.table(id = unique(dt$id))[, unique(dt$y) := 0L][]
Run Code Online (Sandbox Code Playgroud)
剩下的就是填补现有的组合1L.
dt[, {set(ans, i=.GRP, j=unique(y), value=1L); NULL}, by=id]
ans
# id b d c e a
# 1: 1 1 1 1 1 0
# 2: 2 0 0 1 1 1
# 3: 3 0 1 1 1 1
Run Code Online (Sandbox Code Playgroud)
好的,我已经开始对OP的数据维度进行基准测试,大约有1000万行和10列.
require(data.table)
set.seed(45L)
y = apply(matrix(sample(letters, 10L*20L, TRUE), ncol=20L), 1L, paste, collapse="")
dt = data.table(id=sample(1e5,1e7,TRUE), y=sample(y,1e7,TRUE))
system.time(ans1 <- AnsFunction()) # 2.3s
system.time(ans2 <- dcastFunction()) # 2.2s
system.time(ans3 <- TableFunction()) # 6.2s
setcolorder(ans1, names(ans2))
setcolorder(ans3, names(ans2))
setorder(ans1, id)
setkey(ans2, NULL)
setorder(ans3, id)
identical(ans1, ans2) # TRUE
identical(ans1, ans3) # TRUE
Run Code Online (Sandbox Code Playgroud)
哪里,
AnsFunction <- function() {
ans = data.table(id = unique(dt$id))[, unique(dt$y) := 0L][]
dt[, {set(ans, i=.GRP, j=unique(y), value=1L); NULL}, by=id]
ans
# reorder columns outside
}
dcastFunction <- function() {
# no need to load reshape2. data.table has its own dcast as well
# no need for setDT
df <- dcast(dt, id ~ y, fun.aggregate = function(x) 1L, fill=0L,value.var = "y")
}
TableFunction <- function() {
# need to return integer results for identical results
# fixed 1 -> 1L; as.numeric -> as.integer
df <- as.data.frame.matrix(table(dt$id, dt$y))
df[df > 1L] <- 1L
df <- cbind(id = as.integer(row.names(df)), df)
setDT(df)
}
Run Code Online (Sandbox Code Playgroud)