R dplyr 中的多个热编码？

Question

在每个观察可能在单个单元格中输入最多 4 个类别的情况下（我猜是糟糕的数据输入），我如何在 R 中一次性编码它？（也许术语应该是多重热编码，但我不确定）。请注意，大多数观察结果只有一个类别，但有些有 2 个，有的有 3 个，有的有 4 个。总的来说，感兴趣的变量有 7 个不同的类别。这就是我所做的。首先，我将列分成四列并分隔类别，每列一个。然后我在 dplyr 中使用了 mutate 和 spread 函数，但我只能传播第一类 ('firstcrop') 用于一次性编码目的。

我创建了这个数据框来演示我的问题

library(dplyr)
bf <- data.frame(crops = c(1,3,345,9562))
bf <- separate(bf, crops, into = c('empty','firstcrop','secondcrop','thirdcrop','fourthcrop'), sep = "", extra = "merge")
bf <- select(bf, -(empty))

上面的代码成功地将类别分为四个单独的列。接下来我这样做是为了将它们编码为 1 和 0。这仅适用于第一批作物。

cf<- bf%>%mutate(value = 1) %>% spread(firstcrop, value, fill = 0)

但我需要得到这样的结果，其中每个观察值可能有多个 1。

'1'	'2'	'3'	'4'	'5'	'6'	'9'
1	0	0	0	0	0	0
0	0	1	0	0	0	0
0	0	1	1	1	0	0
0	1	0	0	1	1	1

我该怎么做？

Answer 1

如果有人感兴趣，这里有一个 data.table 解决方案：

library(data.table)
bf <- data.table(crops = c(1, 3, 345, 9562))

bf[, crops := strsplit(as.character(crops), "")]
cols <- sort(unique(unlist(bf$crops)))
bf[, (cols) := lapply(cols, \(col) sapply(crops, \(row) col %in% row))]
bf

##      crops     1     2     3     4     5     6     9
## 1:       1  TRUE FALSE FALSE FALSE FALSE FALSE FALSE
## 2:       3 FALSE FALSE  TRUE FALSE FALSE FALSE FALSE
## 3:   3,4,5 FALSE FALSE  TRUE  TRUE  TRUE FALSE FALSE
## 4: 9,5,6,2 FALSE  TRUE FALSE FALSE  TRUE  TRUE  TRUE

还有一个 Base R 解决方案：

bf <- data.frame(crops = c(1, 3, 345, 9562))
bf$crops <- strsplit(as.character(bf$crops), "")
cols <- sort(unique(unlist(bf$crops)))
for (col in cols) {
    bf[[col]] <- sapply(bf$crops, \(row) col %in% row)
}
bf

##        crops     1     2     3     4     5     6     9
## 1          1  TRUE FALSE FALSE FALSE FALSE FALSE FALSE
## 2          3 FALSE FALSE  TRUE FALSE FALSE FALSE FALSE
## 3    3, 4, 5 FALSE FALSE  TRUE  TRUE  TRUE FALSE FALSE
## 4 9, 5, 6, 2 FALSE  TRUE FALSE FALSE  TRUE  TRUE  TRUE

Answer 2

这是一个潜在的 tidyverse 解决方案：

library(dplyr)
library(tidyr)
bf <- data.frame(crops = c(1,3,345,9562))
bf %>%
  separate(crops, into = c('empty',
                           'firstcrop',
                           'secondcrop',
                           'thirdcrop',
                           'fourthcrop'),
           sep = "", extra = "merge") %>%
  select(-(empty))  %>%
  mutate(row = row_number()) %>%
  pivot_longer(-row) %>%
  na.omit() %>%
  pivot_wider(names_from = value,
              values_from = name) %>%
  select(-row) %>%
  mutate(across(everything(), ~+!is.na(.x))) %>%
  select(order(colnames(.)))
#> Warning: Expected 5 pieces. Missing pieces filled with `NA` in 3 rows [1, 2, 3].
#> # A tibble: 4 × 7
#>     `1`   `2`   `3`   `4`   `5`   `6`   `9`
#>   <int> <int> <int> <int> <int> <int> <int>
#> 1     1     0     0     0     0     0     0
#> 2     0     0     1     0     0     0     0
#> 3     0     0     1     1     1     0     0
#> 4     0     1     0     0     1     1     1

^{由 reprex package (v2.0.1)}

于 2022 年 3 月 14 日创建

R dplyr 中的多个热编码？

multiple hot encoding in R dplyr?

r

dplyr

one-hot-encoding