How to convert factor variables with one-hot coding using data.table?

Question

For these unfamiliar ones, one-time coding simply refers to the conversion of a column of categories (i.e. a factor) into several columns of binary indicator variables, where each new column corresponds to one of the classes of the source column. This example will explain this better:

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 

This is what I do a lot, and as you can see, it is rather tedious (especially when my data has many columns of factors). Is there an easier way to do this with data.table? In particular, I suggested that dcast would allow me to parse multiple columns at once when I try to do something like

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

I get column combinations

  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 

Answer 1

Here you go:

 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 

To get the missing factors, you can do the following:

 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 

Answer 2

Using 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 

It makes sense if you are doing a simulation.

If you want to suppress the interception (and restore the column with an alias for the first variable):

 > 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 

Answer 3

Here's a more generalized version of eddi's solution:

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

Note that for large datasets it is better to use Matrix::sparse.model.matrix

Update (2017)

It is now in the mltools package.

Answer 4

If no one publishes a clean way to write this manually, you can always make the / macro function:

 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