Automatically expanding an R factor into a collection of 1/0 indicator variables for every factor level

I have an R data frame containing a factor that I want to "expand" so that for each factor level, there is an associated column in a new data frame, which contains a 1/0 indicator. E.g., suppose I have:

df.original <-data.frame(eggs = c("foo", "foo", "bar", "bar"), ham = c(1,2,3,4))

I want:

df.desired  <- data.frame(foo = c(1,1,0,0), bar=c(0,0,1,1), ham=c(1,2,3,4))

Because for certain analyses for which you need to have a comple开发者_高级运维tely numeric data frame (e.g., principal component analysis), I thought this feature might be built in. Writing a function to do this shouldn't be too hard, but I can foresee some challenges relating to column names and if something exists already, I'd rather use that.

Use the model.matrix function:

model.matrix( ~ Species - 1, data=iris )

If your data frame is only made of factors (or you are working on a subset of variables which are all factors), you can also use the acm.disjonctif function from the ade4 package :

R> library(ade4)
R> df <-data.frame(eggs = c("foo", "foo", "bar", "bar"), ham = c("red","blue","green","red"))
R> acm.disjonctif(df)
  eggs.bar eggs.foo ham.blue ham.green ham.red
1        0        1        0         0       1
2        0        1        1         0       0
3        1        0        0         1       0
4        1        0        0         0       1

Not exactly the case you are describing, but it can be useful too...

A quick way using the reshape2 package:

require(reshape2)

> dcast(df.original, ham ~ eggs, length)

Using ham as value column: use value_var to override.
  ham bar foo
1   1   0   1
2   2   0   1
3   3   1   0
4   4   1   0

Note that this produces precisely the column names you want.

probably dummy variable is similar to what you want. Then, model.matrix is useful:

> with(df.original, data.frame(model.matrix(~eggs+0), ham))
  eggsbar eggsfoo ham
1       0       1   1
2       0       1   2
3       1       0   3
4       1       0   4

A late entry class.ind from the nnet package

library(nnet)
 with(df.original, data.frame(class.ind(eggs), ham))
  bar foo ham
1   0   1   1
2   0   1   2
3   1   0   3
4   1   0   4

Just came across this old thread and thought I'd add a function that utilizes ade4 to take a dataframe consisting of factors and/or numeric data and returns a dataframe with factors as dummy codes.

dummy <- function(df) {  

    NUM <- function(dataframe)dataframe[,sapply(dataframe,is.numeric)]
    FAC <- function(dataframe)dataframe[,sapply(dataframe,is.factor)]

    require(ade4)
    if (is.null(ncol(NUM(df)))) {
        DF <- data.frame(NUM(df), acm.disjonctif(FAC(df)))
        names(DF)[1] <- colnames(df)[which(sapply(df, is.numeric))]
    } else {
        DF <- data.frame(NUM(df), acm.disjonctif(FAC(df)))
    }
    return(DF)
} 

Let's try it.

df <-data.frame(eggs = c("foo", "foo", "bar", "bar"), 
            ham = c("red","blue","green","red"), x=rnorm(4))     
dummy(df)

df2 <-data.frame(eggs = c("foo", "foo", "bar", "bar"), 
            ham = c("red","blue","green","red"))  
dummy(df2)

Here is a more clear way to do it. I use model.matrix to create the dummy boolean variables and then merge it back into the original dataframe.

df.original <-data.frame(eggs = c("foo", "foo", "bar", "bar"), ham = c(1,2,3,4))
df.original
#   eggs ham
# 1  foo   1
# 2  foo   2
# 3  bar   3
# 4  bar   4

# Create the dummy boolean variables using the model.matrix() function.
> mm <- model.matrix(~eggs-1, df.original)
> mm
#   eggsbar eggsfoo
# 1       0       1
# 2       0       1
# 3       1       0
# 4       1       0
# attr(,"assign")
# [1] 1 1
# attr(,"contrasts")
# attr(,"contrasts")$eggs
# [1] "contr.treatment"

# Remove the "eggs" prefix from the column names as the OP desired.
colnames(mm) <- gsub("eggs","",colnames(mm))
mm
#   bar foo
# 1   0   1
# 2   0   1
# 3   1   0
# 4   1   0
# attr(,"assign")
# [1] 1 1
# attr(,"contrasts")
# attr(,"contrasts")$eggs
# [1] "contr.treatment"

# Combine the matrix back with the original dataframe.
result <- cbind(df.original, mm)
result
#   eggs ham bar foo
# 1  foo   1   0   1
# 2  foo   2   0   1
# 3  bar   3   1   0
# 4  bar   4   1   0

# At this point, you can select out the columns that you want.

I needed a function to 'explode' factors that is a bit more flexible, and made one based on the acm.disjonctif function from the ade4 package. This allows you to choose the exploded values, which are 0 and 1 in acm.disjonctif. It only explodes factors that have 'few' levels. Numeric columns are preserved.

# Function to explode factors that are considered to be categorical,
# i.e., they do not have too many levels.
# - data: The data.frame in which categorical variables will be exploded.
# - values: The exploded values for the value being unequal and equal to a level.
# - max_factor_level_fraction: Maximum number of levels as a fraction of column length. Set to 1 to explode all factors.
# Inspired by the acm.disjonctif function in the ade4 package.
explode_factors <- function(data, values = c(-0.8, 0.8), max_factor_level_fraction = 0.2) {
  exploders <- colnames(data)[sapply(data, function(col){
      is.factor(col) && nlevels(col) <= max_factor_level_fraction * length(col)
    })]
  if (length(exploders) > 0) {
    exploded <- lapply(exploders, function(exp){
        col <- data[, exp]
        n <- length(col)
        dummies <- matrix(values[1], n, length(levels(col)))
        dummies[(1:n) + n * (unclass(col) - 1)] <- values[2]
        colnames(dummies) <- paste(exp, levels(col), sep = '_')
        dummies
      })
    # Only keep numeric data.
    data <- data[sapply(data, is.numeric)]
    # Add exploded values.
    data <- cbind(data, exploded)
  }
  return(data)
}

(The question is 10yo, but for the sake of completeness...)

The function i() from the fixest package does exactly that.

Beyond creating a design matrix from a factor-like variable, you can also very easily do two extra things on the fly:

• binning values (with the argument 'bin'),
• excluding some factor values (with the argument ref).

And since it is made for this task, if your variable happens to be numeric you don't need to wrap it with factor(x_num) (as opposed to the model.matrix solution).

Here's an example:

library(fixest)
data(airquality)
table(airquality$Month)
#>  5  6  7  8  9 
#> 31 30 31 31 30

head(i(airquality$Month))
#>      5 6 7 8 9
#> [1,] 1 0 0 0 0
#> [2,] 1 0 0 0 0
#> [3,] 1 0 0 0 0
#> [4,] 1 0 0 0 0
#> [5,] 1 0 0 0 0
#> [6,] 1 0 0 0 0

#
# Binning (check out the help, there are many many ways to bin)
#

colSums(i(airquality$Month, bin = 5:6)))
#>  5  7  8  9 
#> 61 31 31 30 

#
# References
#

head(i(airquality$Month, ref = c(6, 9)), 3)
#>      5 7 8
#> [1,] 1 0 0
#> [2,] 1 0 0
#> [3,] 1 0 0

And here's a little wrapper expanding all non-numeric variables (by default):

library(fixest)

# data: data.frame
# var: vector of variable names // if missing, all non numeric variables
# no argument checking
expand_factor = function(data, var){
    
    if(missing(var)){
        var = names(data)[!sapply(data, is.numeric)]
        if(length(var) == 0) return(data)
    }
    
    data_list = unclass(data)
    new = lapply(var, \(x) i(data_list[[x]]))
    data_list[names(data_list) %in% var] = new
    
    do.call("cbind", data_list)
}

my_data = data.frame(eggs = c("foo", "foo", "bar", "bar"), ham = c(1,2,3,4))

expand_factor(my_data)
#>      bar foo ham
#> [1,]   0   1   1
#> [2,]   0   1   2
#> [3,]   1   0   3
#> [4,]   1   0   4

Finally, for those wondering, the timing is equivalent to the model.matrix solution.

library(microbenchmark)
my_data = data.frame(x = as.factor(sample(100, 1e6, TRUE)))

microbenchmark(mm = model.matrix(~x, my_data),
               i = i(my_data$x), times = 5)
#> Unit: milliseconds
#>  expr      min       lq     mean   median       uq      max neval
#>    mm 155.1904 156.7751 209.2629 182.4964 197.9084 353.9443     5
#>     i 154.1697 154.7893 159.5202 155.4166 163.9706 169.2550     5

In sapply == over eggs could be used to generate dummy vectors:

x <- with(df.original, data.frame(+sapply(unique(eggs), `==`, eggs), ham))
x
#  foo bar ham
#1   1   0   1
#2   1   0   2
#3   0   1   3
#4   0   1   4

all.equal(x, df.desired)
#[1] TRUE

A maybe faster variant - Result best used as list or data.frame:

. <- unique(df.original$eggs)
with(df.original, 
     data.frame(+do.call(cbind, lapply(setNames(., .), `==`, eggs)), ham))

Indexing in a matrix - Result best used as matrix:

. <- unique(df.original$eggs)
i <- match(df.original$eggs, .)
nc <- length(.)
nr <- length(i)
cbind(matrix(`[<-`(integer(nc * nr), 1:nr + nr * (i - 1), 1), nr, nc,
                 dimnames=list(NULL, .)), df.original["ham"])

Using outer - Result best used as matrix:

. <- unique(df.original$eggs)
cbind(+outer(df.original$eggs, setNames(., .), `==`), df.original["ham"])

Using rep - Result best used as matrix:

. <- unique(df.original$eggs)
n <- nrow(df.original)
cbind(+matrix(df.original$eggs == rep(., each=n), n, dimnames=list(NULL, .)),
 df.original["ham"])