R中一组列的热编码

Question

我正在尝试对 R 中 df 列的子集进行热编码，

一种热编码是将分类变量转换为可提供给 ML 算法的形式的过程，通过将字符串列转换为该列中每个字符串的二进制列来更好地进行预测。

假设我们有一个看起来像这样的 df：

mes          work_location  birth_place
01/01/2000      China           Chile
01/02/2000      Mexico           Japan
01/03/2000      China            Chile
01/04/2000      China           Argentina
01/05/2000      USA              Poland
01/06/2000      Mexico           Poland
01/07/2000      USA              Finland
01/08/2000      USA              Finland
01/09/2000      Japan             Norway
01/10/2000      Japan             Kenia
01/11/2000      Japan              Mali
01/12/2000      India              Mali

这是热编码的代码：

## function to hot-encode ##
columna_dummy <- function(df, columna) {
  df %>% 
    mutate_at(columna, ~paste(columna, eval(as.symbol(columna)), sep = "_")) %>% 
    mutate(valor = 1) %>% 
    spread(key = columna, value = valor, fill = 0)
}

## selecting columns ##
columnas <- c("work_location", "birth_place")

## applying loop to repeat columna_dummy function for each df column ##


for(i in 1:length(columnas)){
    new_dataset <- columna_dummy(df, i)
   } 

控制台输出：

Error: Problem with `mutate()` input `mes`.
x objeto '1' no encontrado
i Input `mes` is `(structure(function (..., .x = ..1, .y = ..2, . = ..1) ...`.
Run `rlang::last_error()` to see where the error occurred.
Called from: signal_abort(cnd) 

列mes它是一个日期类列，但它不包含在列原子向量中 它仍然会引发上述错误，

对于所选字符串 df 列中的每个字符串，预期的输出应该如下所示：

（我无法添加每一列，但 work_location_China 这是一个示例 列的外观）

mes          work_location  birth_place    work_location_China   
01/01/2000      China           Chile              1
01/02/2000      Mexico           Japan             0
01/03/2000      China            Chile             1
01/04/2000      China           Argentina          1
01/05/2000      USA              Poland            0
01/06/2000      Mexico           Poland            0
01/07/2000      USA              Finland           0
01/08/2000      USA              Finland           0
01/09/2000      Japan             Norway           0
01/10/2000      Japan             Kenia            0
01/11/2000      Japan              Mali            0
01/12/2000      India              Mali            0

还有其他方法可以应用这个循环吗？

Answer 1

当我们传递字符串时，一个选项是select 列（select 可以带引号/不带引号），创建一个 1 列（'valor'）和一个行号列（'rn'） ，然后进行从“长”到“宽”的重塑 (pivot_wider)

library(dplyr)
library(tidyr)
library(purrr)
library(stringr)
columna_dummy <- function(df, columna) {
      df %>% 
            select(columna) %>%
            mutate(valor = 1, rn = row_number()) %>%
            pivot_wider(names_from = all_of(columna), 
             values_from = valor, values_fill = 0) %>%
            select(-rn)
   }

-测试

对于多个列，一个选项是使用map 循环遍历感兴趣的列名称，应用函数并将它们与_dfc 绑定并与原始数据集绑定 (bind_cols)

out <- imap_dfc(setNames(c("work_location", "birth_place"),
        c("work_location", "birth_place")) , ~ {
     nm1 <- as.character(.y)
    columna_dummy(df = df, columna = .x) %>% 
      rename_all(~ str_c(nm1, ., sep="_"))
       }) %>%            
      bind_cols(df, .)

-输出

head(out, 2)
#         mes work_location birth_place work_location_China work_location_Mexico work_location_USA work_location_Japan
#1 01/01/2000         China       Chile                   1                    0                 0                   0
#2 01/02/2000        Mexico       Japan                   0                    1                 0                   0
#  work_location_India birth_place_Chile birth_place_Japan birth_place_Argentina birth_place_Poland birth_place_Finland
#1                   0                 1                 0                     0                  0                   0
#2                   0                 0                 1                     0                  0                   0
#  birth_place_Norway birth_place_Kenia birth_place_Mali
#1                  0                 0                0
#2                  0                 0                0

数据

df <- structure(list(mes = c("01/01/2000", "01/02/2000", "01/03/2000", 
"01/04/2000", "01/05/2000", "01/06/2000", "01/07/2000", "01/08/2000", 
"01/09/2000", "01/10/2000", "01/11/2000", "01/12/2000"), work_location = c("China", 
"Mexico", "China", "China", "USA", "Mexico", "USA", "USA", "Japan", 
"Japan", "Japan", "India"), birth_place = c("Chile", "Japan", 
"Chile", "Argentina", "Poland", "Poland", "Finland", "Finland", 
"Norway", "Kenia", "Mali", "Mali")), class = "data.frame", 
row.names = c(NA, 
-12L))

Answer 2

通过使用 purrr 库，我解决了这个问题：

## data ##

df <- structure(list(mes = c("01/01/2000", "01/02/2000", "01/03/2000", 
"01/04/2000", "01/05/2000", "01/06/2000", "01/07/2000", "01/08/2000", 
"01/09/2000", "01/10/2000", "01/11/2000", "01/12/2000"), work_location = c("China", 
"Mexico", "China", "China", "USA", "Mexico", "USA", "USA", "Japan", 
"Japan", "Japan", "India"), birth_place = c("Chile", "Japan", 
"Chile", "Argentina", "Poland", "Poland", "Finland", "Finland", 
"Norway", "Kenia", "Mali", "Mali")), class = "data.frame", 
row.names = c(NA, 
-12L))

## function to hot-encode ##

columna_dummy <- function(df, columna) {
  df %>% 
    mutate_at(columna, ~paste(columna, eval(as.symbol(columna)), sep = "_")) %>% 
    mutate(valor = 1) %>% 
    spread(key = columna, value = valor, fill = 0)
}

## vector of columns ##

columnas <- c("work_location", "birth_place")


## hot_encoded_dataset ##
library(purrr)

hot_encoded_dataset <- purrr :: map(columnas , columna_dummy, df = df) %>% 
  reduce(inner_join)