如何基于 data.table 中的分类变量以编程方式创建二进制列？答案

【问题标题】：How to programmatically create binary columns based on a categorical variable in data.table?如何基于 data.table 中的分类变量以编程方式创建二进制列？
【发布时间】：2016-06-10 07:19:56
【问题描述】：

我有一个很大的（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

我想创建一个新的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

我尝试在循环中执行此操作，但速度很慢，而且我不知道如何以编程方式传递二进制变量名称，因为它们取决于我试图“拆分”的变量。

编辑：正如@mtoto 指出的那样，here 已经提出并回答了类似的问题，但解决方案是使用reshape2 包。
我想知道是否有另一种（更快的）方法可以使用 data.table 中的 := 运算符，因为我有一个庞大的数据集，并且我正在使用这个包进行很多工作。

EDIT2：@Arun 帖子中关于我的数据的函数基准测试（约 1200 万行、约 350 万个不同的 id 和 490 个不同的标签，用于y 变量（结果为 490虚拟变量））：

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

【问题讨论】：

我注意到有类似的行，例如四和五，你能解释一下这个数据吗？据我了解data[1][e]=1 if(2>0) else 0 但这似乎有点奇怪。
How to use cast or another function to create a binary table in R的可能重复
@kpie 我编辑了第二个data.table，现在应该更清楚了：id n.1 具有y 的不同值b,c,d,e，但不是a。这就解释了为什么他在第二个data.table 上的行除了a 列之外的所有地方都有1。 @mtoto 感谢您的回答，这将解决我的问题，但是有了如此庞大的数据，我想知道是否有另一种方法可以在 data.table 内部做同样的事情，也许是 := 运算符。
如果你想使用data.table，你可以使用dcast()：dcast(dt, id ~ y,fun.aggregate = function(x) (length(x) > 0)+0)
你也可以考虑将你的 1/0 放在一个“矩阵”中，可能是稀疏的以节省一些内存——uy = unique(dt$y); m = matrix(0L, max(dt$id), length(uy), dimnames = list(NULL, uy)); m[cbind(dt$id, match(dt$y, uy))] = 1L

标签： r data.table binary-data programmatically-created

【解决方案1】：

data.table 有自己的 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 的数据维度上进行了基准测试，大约 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

在哪里，

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

【讨论】：

您的方法看起来正是我想要的。我明白了，但是当我在dt 上运行您的第二种方法的代码时，它不起作用，我得到Empty data.table (0 rows) of 1 col: id
@helter，您能否编辑您的 Q 以在您的原始数据上显示上面发布的两种方法之间的运行时间基准？
这根本不是问题，我只是以前做不到，我认为@Tobias 的基准测试就足够了。我刚刚在问题中添加了基准。
太棒了，谢谢。我计划为下一个版本改进dcast。绝对有助于了解如何不去改进dcast()。
我认为TableFunction 中最慢的部分是table(dt$id, dt$y)。事实上，在处理这个数据集时，我注意到table() 通常非常很慢，可能是因为我有太多ids。出于这个原因，通常我倾向于在j 参数中使用data.table 的.N 运算符，同时对by=id 进行子集化。也许改变TableFunction 中的那个位会提高性能（？），但我看不出如何在没有table() 的情况下获得TableFunction 第一行的相同输出@

【解决方案2】：

对于小型数据集，表函数似乎更有效，但在大型数据集上，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

【讨论】：

我在我的帖子中添加了一个关于更大数据的基准。我不确定您是在运行 data.table 的 dcast 还是 reshape2，因为您使用的是 setDT()，如果您使用 data.table 则没有必要。并且 reshape2::dcast 是 slow.
而不是table + [<-.data.frame，替代品是uy = unique(dt$y); m = matrix(0L, max(dt$id), length(uy), dimnames = list(NULL, uy)); m[cbind(dt$id, match(dt$y, uy))] = 1L

【解决方案3】：

如果您已经知道行的范围（因为您知道示例中的行不超过 3 行）并且您知道列，您可以从零数组开始并使用 apply 函数更新值在那个辅助表中。

我的 R 有点生锈，但我认为应该可以。此外，您传递给 apply 方法的函数可能包含根据需要添加必要行和列的条件。

我的 R 有点生锈，所以我现在有点犹豫要写它，但我认为这是这样做的方法。

如果您正在寻找更多即插即用的东西，我发现了这个小问题：

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/

如果我更精通 R，我会告诉你这些不同的方法如何处理从长列表到宽列表的冲突。我在谷歌上搜索“从 R 中的平面数据制作表格”来想出这个......

还可以查看 this 与我个人评论包装器相同的网站：p

【讨论】：