如何以編程方式基於data.table中的分類變量創建二進制列？

Question

我有一個大（12萬行）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 

我想創建一個新的data.table包含我的變量id（這將是這個新data.table獨特的鍵）和其他5二進制變量，每個對應於y的每個類別，如果該值具有y的該值，則其值爲1，否則爲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 

我試着在一個循環中這樣做，但它是相當緩慢的，也不知如何以編程方式通過二元變量名，因爲它們依賴於變量我試圖「分裂」。

編輯：作爲@mtoto指出，類似的問題已經被問和回答here，但解決的辦法是使用reshape2包。
我想知道是否有另一種（更快）的方式來做到這一點，可能在data.table中使用:=運算符，因爲我有一個龐大的數據集，我在這個包中工作很多。

EDIT2：在@ Arun的崗位上我的數據的功能指標（〜1200萬行，〜3.5萬個不同的ID和490個不同的標籤爲y變量（導致490個虛擬變量））：

system.time(ans1 <- AnsFunction()) # 194s 
system.time(ans2 <- dcastFunction()) # 55s 
system.time(ans3 <- TableFunction()) # Takes forever and blocked my PC 

Answer 1

數據。表有自己的dcast實現使用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 

---

只是想到了另外一個辦法，通過參考預分配和更新來處理這個（也許dcast的邏輯應該這樣做，以避免中間體）。

ans = data.table(id = unique(dt$id))[, unique(dt$y) := 0L][] 

剩下的就是用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 

---

好吧，我已經先行一步對OP的尺寸數據與基準約10萬行和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 

其中，

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) 
} 

Answer 2

如果你已經知道行的範圍（因爲你知道在你的例子中不超過3行）並且你知道列可以從一個零數組開始並使用apply函數更新該輔助表中的值。

我的R是有點生鏽，但我認爲應該工作。另外，您傳遞給apply方法的函數可能包含根據需要添加必要的行和列的條件。

我的R有點生鏽，所以我現在有點嘗試性地寫下它，但我認爲這是做到這一點的方法。

如果你正在尋找的東西多一點即插即用我發現這個小blerb：

There are two sets of methods that are explained below: 

gather() and spread() from the tidyr package. This is a newer interface to the reshape2 package. 

melt() and dcast() from the reshape2 package. 

There are a number of other methods which aren’t covered here, since they are not as easy to use: 

The reshape() function, which is confusingly not part of the reshape2 package; it is part of the base install of R. 

stack() and unstack() 

從這裏:: http://www.cookbook-r.com/Manipulating_data/Converting_data_between_wide_and_long_format/

如果我在RI更好的人員會告訴你如何將這些各種方法處理從長列表到寬列表的衝突。我在谷歌上搜索了「建立從R中平面數據表」想出這個...

還檢查了this這是同一網站如上面我個人的意見包裝：P

Answer 3

對於小型數據集，表函數似乎更有效，但對大數據集dcast似乎是最有效和最方便的選擇。

TableFunction <- function(){ 
    df <- as.data.frame.matrix(table(dt$id, dt$y)) 
    df[df > 1] <- 1 
    df <- cbind(id = as.numeric(row.names(df)), df) 
    setDT(df) 
} 


AnsFunction <- function(){ 
    ans = data.table(id = unique(dt$id))[, unique(dt$y) := 0L][] 
    dt[, {set(ans, i=id, j=unique(y), value=1L); NULL}, by=id] 
} 

dcastFunction <- function(){ 
    df <-dcast.data.table(dt, id ~ y, fun.aggregate = function(x) 1L, fill=0L,value.var = "y") 

} 

library(data.table) 
library(microbenchmark) 
set.seed(123) 
N = 10000 
dt <- data.table(id=rep(1:N, each=5),y=sample(letters[1 : 5], N*5, replace = T)) 


microbenchmark(
    "dcast" = dcastFunction(), 
    "Table" = TableFunction(), 
    "Ans" = AnsFunction() 
    ) 


Unit: milliseconds 
    expr  min  lq  mean median  uq  max neval cld 
dcast 42.48367 45.39793 47.56898 46.83755 49.33388 60.72327 100 b 
Table 28.32704 28.74579 29.14043 29.00010 29.23320 35.16723 100 a 
    Ans 120.80609 123.95895 127.35880 126.85018 130.12491 156.53289 100 c 

> all(test1 == test2) 
[1] TRUE 
> all(test1 == test3) 
[1] TRUE 

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)) 

microbenchmark(
    "dcast" = dcastFunction(), 
    "Table" = TableFunction(), 
    "Ans" = AnsFunction() 
) 
Unit: seconds 
    expr  min  lq  mean median  uq  max neval cld 
dcast 1.985969 2.064964 2.189764 2.216138 2.266959 2.643231 100 a 
Table 5.022388 5.403263 5.605012 5.580228 5.830414 6.318729 100 c 
    Ans 2.234636 2.414224 2.586727 2.599156 2.645717 2.982311 100 b