【问题标题】：How to one-hot-encode factor variables with data.table?如何使用 data.table 对因子变量进行一次热编码？
【发布时间】：2016-10-06 21:22:00
【问题描述】：

对于那些不熟悉的人，one-hot encoding 只是指将一列类别（即一个因子）转换为多列二进制指标变量，其中每个新列对应于原始列的一个类。这个例子会更好地解释它：

dt <- data.table(
  ID=1:5, 
  Color=factor(c("green", "red", "red", "blue", "green"), levels=c("blue", "green", "red", "purple")),
  Shape=factor(c("square", "triangle", "square", "triangle", "cirlce"))
)

dt
   ID Color    Shape
1:  1 green   square
2:  2   red triangle
3:  3   red   square
4:  4  blue triangle
5:  5 green   cirlce

# one hot encode the colors
color.binarized <- dcast(dt[, list(V1=1, ID, Color)], ID ~ Color, fun=sum, value.var="V1", drop=c(TRUE, FALSE))

# Prepend Color_ in front of each one-hot-encoded feature
setnames(color.binarized, setdiff(colnames(color.binarized), "ID"), paste0("Color_", setdiff(colnames(color.binarized), "ID")))

# one hot encode the shapes
shape.binarized <- dcast(dt[, list(V1=1, ID, Shape)], ID ~ Shape, fun=sum, value.var="V1", drop=c(TRUE, FALSE))

# Prepend Shape_ in front of each one-hot-encoded feature
setnames(shape.binarized, setdiff(colnames(shape.binarized), "ID"), paste0("Shape_", setdiff(colnames(shape.binarized), "ID")))

# Join one-hot tables with original dataset
dt <- dt[color.binarized, on="ID"]
dt <- dt[shape.binarized, on="ID"]

dt
   ID Color    Shape Color_blue Color_green Color_red Color_purple Shape_cirlce Shape_square Shape_triangle
1:  1 green   square          0           1         0            0            0            1              0
2:  2   red triangle          0           0         1            0            0            0              1
3:  3   red   square          0           0         1            0            0            1              0
4:  4  blue triangle          1           0         0            0            0            0              1
5:  5 green   cirlce          0           1         0            0            1            0              0

这是我经常做的事情，正如您所见，它非常乏味（尤其是当我的数据有很多因子列时）。有没有更简单的方法可以用 data.table 做到这一点？特别是，当我尝试做类似的事情时，我认为 dcast 将允许我一次对多个列进行一次热编码

dcast(dt[, list(V1=1, ID, Color, Shape)], ID ~ Color + Shape, fun=sum, value.var="V1", drop=c(TRUE, FALSE))

我得到列组合

   ID blue_cirlce blue_square blue_triangle green_cirlce green_square green_triangle red_cirlce red_square red_triangle purple_cirlce purple_square purple_triangle
1:  1           0           0             0            0            1              0          0          0            0             0             0               0
2:  2           0           0             0            0            0              0          0          0            1             0             0               0
3:  3           0           0             0            0            0              0          0          1            0             0             0               0
4:  4           0           0             1            0            0              0          0          0            0             0             0               0
5:  5           0           0             0            1            0              0          0          0            0             0             0               0

【问题讨论】：

对于 OHE，最好使用稀疏矩阵。
@DavidArenburg 感谢您的快速回复。在生产模型中我通常会这样做，但是当我修改新想法并在小型数据集上进行测试时，我喜欢使用 data.table，因为它更容易查看/绘制/子集
好的，那我就做dcast(melt(dt, 1), ID ~ value, length)。在某个地方可能有一个骗局
?model.matrix

标签： r data.table

【解决方案1】：

给你：

dcast(melt(dt, id.vars='ID'), ID ~ variable + value, fun = length)
#   ID Color_blue Color_green Color_red Shape_cirlce Shape_square Shape_triangle
#1:  1          0           1         0            0            1              0
#2:  2          0           0         1            0            0              1
#3:  3          0           0         1            0            1              0
#4:  4          1           0         0            0            0              1
#5:  5          0           1         0            1            0              0

要获得缺失的因素，您可以执行以下操作：

res = dcast(melt(dt, id = 'ID', value.factor = T), ID ~ value, drop = F, fun = length)
setnames(res, c("ID", unlist(lapply(2:ncol(dt),
                             function(i) paste(names(dt)[i], levels(dt[[i]]), sep = "_")))))
res
#   ID Color_blue Color_green Color_red Color_purple Shape_cirlce Shape_square Shape_triangle
#1:  1          0           1         0            0            0            1              0
#2:  2          0           0         1            0            0            0              1
#3:  3          0           0         1            0            0            1              0
#4:  4          1           0         0            0            0            0              1
#5:  5          0           1         0            0            1            0              0

【讨论】：

啊，这看起来很优雅，但不幸的是它缺少 Color_purple（未使用的颜色级别）。
看来我抢了先机。不幸的是，这只适用于每个因子列的水平完全不同的情况。很确定我可以修复它。你让我走了 90% 的路。
@Ben 可能会从这个开始，然后你以后不需要重命名：newdt = setDT(lapply(1:ncol(dt), function(i) if (is.factor(dt[[i]])) { factor(paste(names(dt)[i], levels(dt[[i]]), sep = "_"))[dt[[i]]] } else { dt[[i]] }))

【解决方案2】：

使用model.matrix：

> cbind(dt[, .(ID)], model.matrix(~ Color + Shape, dt))
   ID (Intercept) Colorgreen Colorred Colorpurple Shapesquare Shapetriangle
1:  1           1          1        0           0           1             0
2:  2           1          0        1           0           0             1
3:  3           1          0        1           0           1             0
4:  4           1          0        0           0           0             1
5:  5           1          1        0           0           0             0

如果你在做建模，这是最有意义的。

如果你想抑制截距（并恢复第一个变量的别名列）：

> cbind(dt[, .(ID)], model.matrix(~ Color + Shape - 1, dt))
   ID Colorblue Colorgreen Colorred Colorpurple Shapesquare Shapetriangle
1:  1         0          1        0           0           1             0
2:  2         0          0        1           0           0             1
3:  3         0          0        1           0           1             0
4:  4         1          0        0           0           0             1
5:  5         0          1        0           0           0             0

【讨论】：

Matrix::sparse.model.matrix 会更好。
Shapecirlce 不见了...？
@eddi Shapecircle 可以从Shapesquare 和Shapetriangle 的值中推断出来。表示 n 个级别通常需要 n-1 列。
@HongOoi 虽然这是真的，但 one-hot-encoding 经常用于机器学习模型，这些模型随机采样列的子集（例如随机森林、梯度提升等）。使用这些模型，通常最好包含所有数据列，因为在获取列子集后无法推断出缺少的列。
@Ben 我不确定我是否理解您关于使用 n 列而不是 n-1 的评论

【解决方案3】：

这是 eddi 解决方案的更通用版本：

one_hot <- function(dt, cols="auto", dropCols=TRUE, dropUnusedLevels=FALSE){
  # One-Hot-Encode unordered factors in a data.table
  # If cols = "auto", each unordered factor column in dt will be encoded. (Or specifcy a vector of column names to encode)
  # If dropCols=TRUE, the original factor columns are dropped
  # If dropUnusedLevels = TRUE, unused factor levels are dropped

  # Automatically get the unordered factor columns
  if(cols[1] == "auto") cols <- colnames(dt)[which(sapply(dt, function(x) is.factor(x) & !is.ordered(x)))]

  # Build tempDT containing and ID column and 'cols' columns
  tempDT <- dt[, cols, with=FALSE]
  tempDT[, ID := .I]
  setcolorder(tempDT, unique(c("ID", colnames(tempDT))))
  for(col in cols) set(tempDT, j=col, value=factor(paste(col, tempDT[[col]], sep="_"), levels=paste(col, levels(tempDT[[col]]), sep="_")))

  # One-hot-encode
  if(dropUnusedLevels == TRUE){
    newCols <- dcast(melt(tempDT, id = 'ID', value.factor = T), ID ~ value, drop = T, fun = length)
  } else{
    newCols <- dcast(melt(tempDT, id = 'ID', value.factor = T), ID ~ value, drop = F, fun = length)
  }

  # Combine binarized columns with the original dataset
  result <- cbind(dt, newCols[, !"ID"])

  # If dropCols = TRUE, remove the original factor columns
  if(dropCols == TRUE){
    result <- result[, !cols, with=FALSE]
  }

  return(result)
}

请注意，对于大型数据集，最好使用Matrix::sparse.model.matrix

更新（2017 年）

现在在包mltools中。

【讨论】：

您的函数对我来说非常有用，但由于它在 n 列中转换 n 个因子水平，因此对于创建对多重共线性敏感的模型没有用处。是否有调整后的函数版本，每个因子列产生 n-1 个虚拟列？
@Constantin 否，但您可以在编码后删除其中一列。

【解决方案4】：

如果没有人每次都发布一种清晰的手写方式，您可以随时制作一个函数/宏：

OHE <- function(dt, grp, encodeCols) {
        grpSymb = as.symbol(grp)
        for (col in encodeCols) {
                colSymb = as.symbol(col)
                eval(bquote(
                            dt[, .SD
                               ][, V1 := 1
                               ][, dcast(.SD, .(grpSymb) ~ .(colSymb), fun=sum, value.var='V1')
                               ][, setnames(.SD, setdiff(colnames(.SD), grp), sprintf("%s_%s", col, setdiff(colnames(.SD), grp)))
                               ][, dt <<- dt[.SD, on=grp]
                               ]
                            ))
        }
        dt
}

dtOHE = OHE(dt, 'ID', c('Color', 'Shape'))
dtOHE

   ID Color    Shape Color_blue Color_green Color_red Shape_cirlce Shape_square Shape_triangle
1:  1 green   square          0           1         0            0            1              0
2:  2   red triangle          0           0         1            0            0              1
3:  3   red   square          0           0         1            0            1              0
4:  4  blue triangle          1           0         0            0            0              1
5:  5 green   cirlce          0           1         0            1            0              0

【讨论】：

【解决方案5】：

几行就可以解决这个问题：

library(tidyverse)
dt2 <- spread(dt,Color,Shape)
dt3 <- spread(dt,Shape,Color)

df <- cbind(dt2,dt3)

df2 <- apply(df, 2, function(x){sapply(x, function(y){
  ifelse(is.na(y),0,1)
})})

df2 <- as.data.frame(df2)

df <- cbind(dt,df2[,-1])

【讨论】：