Создайте фрейм данных 0-1 на основе совпадающих значений в именах столбцов и определенного столбца в r

Я хочу повторно заполнить фрейм данных в соответствии с совпадающими значениями / классами имен столбцов и информацией, предоставленной в другом столбце.

Вот гипотетический фрейм данных:

> 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 

Мне каким-то образом удалось извлечь совпадающие значения с помощью функции сопоставления (например, match(mat.data[,5],colnames(mat.data[1:4]))). Однако я не мог получить желаемый результат в разумные сроки.

Я хочу повторно заполнить значения 0-1 на основе истинного совпадения между именами столбцов данных и 5-м столбцом (поэтому, когда 5-й столбец является A для данной строки, я хочу «1» под столбцом с именем « A ", а для остальных" 0 ").

Для лучшего объяснения желаемый результат:

> 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 

Любые предложения, чтобы сделать его чистым и менее сложным, были бы замечательными.

4
0
81
5
Перейти к ответу Данный вопрос помечен как решенный

Ответы 5

Ответ принят как подходящий

Один из возможных подходов - воссоздать матрицу с помощью model.matrix, но сначала убедитесь, что переменная cat имеет уровни, соответствующие именам столбцов исходной матрицы:

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

Привет, большое спасибо. Это работает очень быстро с огромным набором данных. Для увеличенных номеров столбцов это не сработало. Однако, когда я удалил «-1» здесь head = levels = head(names(mat.data), -1)), это сработало. Было бы здорово, если бы я мог понять, почему или изменяет ли это результат, поскольку у меня нет возможности его контролировать (большая проблема с набором данных)?

DSA 31.10.2018 16:18

Если данные игрушки репрезентативны для реальных данных, проблем быть не должно. Тем не менее, удаление -1 из команды head полностью меняет результат (по умолчанию возвращаются только первые 6 значений, тогда как использование -1 означает все, кроме последнего значения). Вместо этого вы можете использовать names(mat.data) из данных игрушки, в худшем случае у вас должен быть лишний столбец, который можно удалить (cat).

Ritchie Sacramento 01.11.2018 15:15

Решение с использованием outer и 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

Без stringi вы могли бы обойтись

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

Другой вариант с 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

Большое спасибо за опцию, которая напоминает мне, что мне нужно чаще использовать data.table.

DSA 31.10.2018 16:19

Вот способ использования sapply, основанного на преобразовании логических чисел в числа:

> 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

Сроки всех ответов на данный момент:

> 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

Привет, большое спасибо! Одна из проблем sapply: эффективность использования времени может стать очень низкой, если вы работаете с большими данными.

DSA 31.10.2018 16:22

Я только что провел микробенчмарк на всех ответах, и, по крайней мере, для набора данных игрушек sapply был самым быстрым

Gramposity 31.10.2018 18:56

Рад видеть тест. Однако микробенчмарк набора данных игрушек не масштабируется для большего набора данных. Если вы запустите тест с большим набором данных, например n <- 10000; mat.data = data.frame(A = sample(0:1, n, replace = T), B = sample(0:1, n, replace = T), C = sample(0:1, n, replace = T), D = sample(0:1, n, replace = T), cat = sample(LETTERS[1:3], n, replace = T)), вы обнаружите, что model.matrix является наиболее эффективным.

mt1022 01.11.2018 02:28

Вот решение tidyverse на основе 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

Как вы видите, D отсутствует, но он будет там, если в вашем столбце "D" есть какой-либо cat.

Привет, спасибо, это очень удобно, когда отсутствие столбца (в данном случае "D") не имеет значения.

DSA 31.10.2018 16:23

Другие вопросы по теме