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

У меня есть фрейм данных с категориальной переменной, содержащей списки строк с переменной длиной (это важно, потому что в противном случае этот вопрос был бы дубликатом 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 уникальных строк values), всего 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

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


person Giora Simchoni    schedule 16.01.2017    source источник
comment
@alistaire, может быть, levels = unique(unlist(df$y)) вместо LETTERS[1:5]?   -  person Sotos    schedule 16.01.2017
comment
@Sotos У меня было это, но я решил, что это меньше вычислений. Лучший способ - сохранить это как отдельную переменную, но для этого потребуется вторая строка ...   -  person alistaire    schedule 16.01.2017
comment
@alistaire Правда   -  person Sotos    schedule 16.01.2017


Ответы (3)


Мы можем использовать 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
person akrun    schedule 16.01.2017
comment
Это впечатляет и очень быстро (несколько секунд для ~ 1 млн строк с ~ 350 уникальными значениями на моем ПК). У вас есть ответ, не требующий совершенно нового пакета? Спасибо. - person Giora Simchoni; 16.01.2017
comment
@GioraSimchoni Похоже, кто-то еще ответил на него без пакета - person akrun; 16.01.2017
comment
@GioraSimchoni тоже; Думаю, базовая альтернатива table(rep(df$x, lengths(df$y)), unlist(df$y))? - person alexis_laz; 16.01.2017
comment
Не работает с df$x = rep(1,5) или df$x = c(1,1,2,2,3). Не имеет значения, что такое df$x. - person Giora Simchoni; 17.01.2017
comment
@GioraSimchoni Я не уверен, что вы имели в виду не работает? Он дает результат, в котором первый столбец равен 1 (для df$x = rep(1,5)) - person akrun; 17.01.2017
comment
Извините @akrun, я имел в виду комментарий alexis_laz. - person Giora Simchoni; 17.01.2017
comment
@GioraSimchoni: (не заметил комментария) Я неправильно понял, что вы хотели - в этом случае просто используйте table(rep(seq_along(df$y), lengths(df$y)), unlist(df$y)) и cbind df$x, как в ответе Akrun. (@akrun извините за ненужное уведомление) - person alexis_laz; 22.01.2017

Еще одна идея,

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
person Sotos    schedule 16.01.2017
comment
спасибо, посмотрим, что произойдет, когда df $ x = rep (1, 5). Ошибка: повторяющиеся идентификаторы для строк (1, 2), (3, 5), (4, 7) - person Giora Simchoni; 16.01.2017
comment
Каков был бы ваш ожидаемый результат в таком случае? что-то вроде df %>% unnest(y) %>% group_by(x) %>% mutate(new = 1:n()) %>% spread(y, x, fill = 0)? - person Sotos; 16.01.2017
comment
Тот же результат с сохранением исходного столбца x. Это на исходном df дает ошибку: повторяющиеся идентификаторы для строк (1, 2). - person Giora Simchoni; 16.01.2017
comment
Он работает в df$x = rep(1, 5) случае. В исходном случае df$x = 1:5 он дает ошибку: повторяющиеся идентификаторы для строк (1, 2). - person Giora Simchoni; 16.01.2017
comment
Попробуйте mutate(new = 1:n()) до group_by() - person Sotos; 16.01.2017
comment
Не работает ни с df$x = 1:5, ни с df$x = c(1,1,2,2,3). Не имеет значения, что такое df$x. - person Giora Simchoni; 17.01.2017
comment
@GioraSimchoni, ты можешь проверить сейчас? - person Sotos; 17.01.2017

это не связано с внешними пакетами,

# 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
person joel.wilson    schedule 16.01.2017
comment
LETTERS часть плохая. Вместо этого вы можете сделать unique(unlist(df$y)) - person Sotos; 16.01.2017
comment
Не работает с df$x = rep(1,5) или df$x = c(1,1,2,2,3). Не имеет значения, что такое df$x. - person Giora Simchoni; 17.01.2017
comment
@ joel.wilson отлично работает, я сделаю несколько тестов, чтобы увидеть, как он сравнивается с другими более интересными решениями, спасибо. - person Giora Simchoni; 17.01.2017
comment
@GioraSimchoni, как это работает? - person joel.wilson; 17.01.2017