R: создать фиктивные переменные на основе категориального переменный * списки *

Question

У меня есть фрейм данных с категорическим переменным, содержащей списков строк, с переменной длиной (это важно, так как в противном случае этот вопрос будет дубликатом this или this), например:

df <- data.frame(x = 1:5) 
df$y <- list("A", c("A", "B"), "C", c("B", "D", "C"), "E") 
df 

x  y 
1 1  A 
2 2 A, B 
3 3  C 
4 4 B, D, C 
5 5  E 

И желаемая форма является фиктивной переменной для каждой уникальной строки видел где-нибудь в df$y, то есть:

data.frame(x = 1:5, A = c(1,1,0,0,0), B = c(0,1,0,1,0), C = c(0,0,1,1,0), D = c(0,0,0,1,0), E = c(0,0,0,0,1)) 

x A B C D E 
1 1 1 0 0 0 0 
2 2 1 1 0 0 0 
3 3 0 0 1 0 0 
4 4 0 1 1 1 0 
5 5 0 0 0 0 1 

Этот наивный подход работает:

> uniqueStrings <- unique(unlist(df$y)) 
> n <- ncol(df) 
> for (i in 1:length(uniqueStrings)) { 
+ df[, n + i] <- sapply(df$y, function(x) ifelse(uniqueStrings[i] %in% x, 1, 0)) 
+ colnames(df)[n + i] <- uniqueStrings[i] 
+ } 

Однако это очень некрасиво, ленивые и медленно с большими кадрами данных.

Любые предложения? Что-то причудливое от tidyverse?

---

ОБНОВЛЕНИЕ: У меня есть 3 разных подхода ниже. Я тестировал их с помощью system.time на моем (Windows 7, 32 ГБ оперативной памяти) на базе данных реального, состоящий из 1М строк, каждая строка содержит список длиной от 1 до 4 строк (из ~ 350 уникальных строковых значений), общая 200 МБ на диске. Таким образом, ожидаемым результатом является кадр данных с размерами 1M x 350. Подходы tidyverse (@Sotos) и base (@ joel.wilson) заняли так много времени, что мне пришлось перезапустить R. Однако подход qdapTools (@akrun) работал фантастически:

> system.time(res1 <- mtabulate(varsLists)) 
    user system elapsed 
    47.05 10.27 116.82 

Так что это подход, который я буду отмечать.

Answer 1

Мы можем использовать mtabulate

library(qdapTools) 
cbind(df[1], mtabulate(df$y)) 
# x A B C D E 
#1 1 1 0 0 0 0 
#2 2 1 1 0 0 0 
#3 3 0 0 1 0 0 
#4 4 0 1 1 1 0 
#5 5 0 0 0 0 1 

Answer 2

Другая идея,

library(dplyr) 
library(tidyr) 

df %>% 
unnest(y) %>% 
mutate(new = 1) %>% 
spread(y, new, fill = 0) 

# x A B C D E 
#1 1 1 0 0 0 0 
#2 2 1 1 0 0 0 
#3 3 0 0 1 0 0 
#4 4 0 1 1 1 0 
#5 5 0 0 0 0 1 

Далее в случаях, указанных в комментариях, мы можем использовать dcast из reshape2, поскольку это более гибкий, чем spread,

df2 <- df %>% 
     unnest(y) %>% 
     group_by(x) %>% 
     filter(!duplicated(y)) %>% 
     ungroup() 

reshape2::dcast(df2, x ~ y, value.var = 'y', length) 

# x A B C D E 
#1 1 1 0 0 0 0 
#2 2 1 1 0 0 0 
#3 3 0 0 1 0 0 
#4 4 0 1 1 1 0 
#5 5 0 0 0 0 1 

#or with df$x <- c(1, 1, 2, 2, 3) 

# x A B C D E 
#1 1 1 1 0 0 0 
#2 2 0 1 1 1 0 
#3 3 0 0 0 0 1 

#or with df$x <- rep(1,5) 

# x A B C D E 
#1 1 1 1 1 1 1 

Answer 3

этот invo не LVES никаких внешних пакетов,

# thanks to Sotos for suggesting to use `unique(unlist(df$y))` instead of `LETTERS[1!:5]` 
sapply(unique(unlist(df$y)), function(j) as.numeric(grepl(j, df$y))) 
#  A B C D E 
#[1,] 1 0 0 0 0 
#[2,] 1 1 0 0 0 
#[3,] 0 0 1 0 0 
#[4,] 0 1 1 1 0 
#[5,] 0 0 0 0 1