Create a 0-1 dataframe based on matching values in column names and a specific column in R

user_8609239 0
Viewed 82

I want to re-fill a data frame according to matching values/classes of the column names and information giving in another column.

Here is a hypothetical dataframe:

> mat.data = data.frame(A = c(rep(1,2),rep(0,2)), B = c(0,rep(1,2),0) , 
+                       C = rep(0,4), D = c(rep(0,3),1), cat = c(rep("A",2),"C","B"))
> mat.data
 A B C D cat
 1 0 0 0   A
 1 1 0 0   A
 0 1 0 0   C
 0 0 0 1   B

I somehow managed to extract matching values by using match function (e.g. match(mat.data[,5],colnames(mat.data[1:4]))). However, I couldn't get the output I wanted to have in a reasonable amount of time.

I want to re-fill the 0-1 values based on the a true match between the column names of the data and 5th column (So when the 5th column is A for a given row, I want "1" under the column named "A", and "0" for the others).

For a better explanation, desired output is:

> mat.data
 A B C D cat
 1 0 0 0   A
 1 0 0 0   A
 0 0 1 0   C
 0 1 0 0   B

Any suggestions to make it clean and less complicated would be great.

match dataframe r
5 Answers

One possible approach would be to recreate the matrix using model.matrix but first ensure that the cat variable has levels corresponding to the column names of the original matrix:

mat.data$cat <- factor(mat.data$cat, levels = head(names(mat.data), -1))
new.mat <- data.frame(model.matrix( ~  mat.data$cat - 1))
names(new.mat) <- levels(mat.data$cat)

new.mat
  A B C D
1 1 0 0 0
2 1 0 0 0
3 0 0 1 0
4 0 1 0 0
user_28352610

Another option with data.table::dcast:

library(data.table)
setDT(mat.data)
mat.data[, cat := factor(cat, levels = names(mat.data)[1:4])]
res <- dcast(mat.data, cat + seq_along(cat) ~ cat, fun.agg = length, fill = 0, drop = c(T, F))
res[, cat_1 := NULL]

# > res
#    cat A B C D
# 1:   A 1 0 0 0
# 2:   A 1 0 0 0
# 3:   B 0 1 0 0
# 4:   C 0 0 1 0
user_39265430

Here's a way using sapply and relying on logical to numeric conversion:

> cat <- c("A", "A", "C", "B")
> lvls <- LETTERS[1:4]
> 
> mat.data <- t(sapply(cat, function(x) as.numeric(lvls == x)))
> colnames(mat.data) <- lvls
> mat.data
  A B C D
A 1 0 0 0
A 1 0 0 0
C 0 0 1 0
B 0 1 0 0

Timing of all the answers so far:

> microbenchmark(
+   model.matrix = {
+     mat.data = data.frame(A = c(rep(1,2),rep(0,2)), B = c(0,rep(1,2),0) , 
+                                         C = rep(0,4), D = c(rep(0,3),1), cat = c(rep("A",2),"C","B"))
+     mat.data$cat <- factor(mat.data$cat, levels = head(names(mat.data), -1))
+     new.mat <- data.frame(model.matrix( ~  mat.data$cat - 1))
+     names(new.mat) <- levels(mat.data$cat)
+   },
+   dcast = {
+     mat.data = data.frame(A = c(rep(1,2),rep(0,2)), B = c(0,rep(1,2),0) , 
+                           C = rep(0,4), D = c(rep(0,3),1), cat = c(rep("A",2),"C","B"))
+     setDT(mat.data)
+     mat.data[, cat := factor(cat, levels = names(mat.data)[1:4])]
+     res <- dcast(mat.data, cat + seq_along(cat) ~ cat, fun.agg = length, fill = 0, drop = c(T, F))
+     res[, cat_1 := NULL]
+   },
+   outer = {
+     mat.data = data.frame(A = c(rep(1,2),rep(0,2)), B = c(0,rep(1,2),0) , 
+                           C = rep(0,4), D = c(rep(0,3),1), cat = c(rep("A",2),"C","B"))
+     match_cols <- setdiff(names(mat.data), "cat")
+     new.data <- outer(X = mat.data[["cat"]], Y = match_cols, stringi::stri_count_fixed)
+     colnames(new.data) <- match_cols
+     cbind(new.data, mat.data["cat"])
+   },
+   sapply = {
+     mat.data = data.frame(A = c(rep(1,2),rep(0,2)), B = c(0,rep(1,2),0) , 
+                           C = rep(0,4), D = c(rep(0,3),1), cat = c(rep("A",2),"C","B"))
+     lvls <- LETTERS[1:4]
+     new.mat <- t(sapply(mat.data$cat, function(x) as.numeric(lvls == x)))  
+     colnames(new.mat) <- lvls
+   },
+   tidy = {
+     mat.data = data.frame(A = c(rep(1,2),rep(0,2)), B = c(0,rep(1,2),0) , 
+                           C = rep(0,4), D = c(rep(0,3),1), cat = c(rep("A",2),"C","B"))
+     mat.data[5] %>% 
+       rowid_to_column %>% 
+       mutate(value=1) %>% 
+       spread(cat,value, fill=0) %>%
+       select(-rowid)
+   }
+ )
Using 'cat' as value column. Use 'value.var' to override (x100)
Unit: microseconds
         expr      min       lq      mean    median       uq       max neval
 model.matrix  894.835 1027.983 1185.7946 1173.6940 1313.258  1640.453   100
        dcast 4432.031 4935.079 5603.5700 5290.8000 5725.408 12495.376   100
        outer  508.123  564.671  666.4618  610.9195  758.261  1008.386   100
       sapply  463.534  496.724  611.6146  549.5260  672.997  2526.964   100
         tidy 3936.329 4525.921 5000.3296 4917.7735 5257.409 10660.893   100
user_46517870

A solution using outer and stringi::stri_count_fixed

match_cols <- setdiff(names(mat.data), "cat")
new.data <- outer(X = mat.data[["cat"]], Y = match_cols, stringi::stri_count_fixed)
colnames(new.data) <- match_cols
cbind(new.data, mat.data["cat"])
#  A B C D cat
#1 1 0 0 0   A
#2 1 0 0 0   A
#3 0 0 1 0   C
#4 0 1 0 0   B

Without stringi you could do

new.data <- 1 * outer(X = mat.data[["cat"]], Y = count_cols, `==`)
user_85833930

Here's a tidyverse solution based on tidyr::spread:

library(tidyverse)
mat.data[5] %>% 
  rowid_to_column %>% 
  mutate(value=1) %>% 
  spread(cat,value, fill=0) %>%
  select(-rowid)
#   A B C
# 1 1 0 0
# 2 1 0 0
# 3 0 0 1
# 4 0 1 0

As you see D is not present, it will be there if there's any "D" in your cat column though.

user_22704750
Related