重新编码和折叠多个二进制编码列

Question

正在努力寻找一个优雅的解决方案...

我对“请 select 所有适用的”问题做出了回答，其中每个问题的每个选项 A 到 F 都被编码为二进制变量。因此，例如，下面的假数据集中的第一响应者只为问题 1 勾选了 D，然后为问题 2 勾选了 A、C、D 和 E。

library(dplyr)

cols <- paste0('foo', '_', c(1:2, '3a', '3b')) %>%
  lapply(\(i) paste0(i, '_', LETTERS[1:6])) %>%
  unlist()

set.seed(1)
df <- lapply(cols, \(i) i = sample(0:1, 5, replace = TRUE)) %>%
  setNames(cols) %>%
  data.frame()

'data.frame':   5 obs. of  24 variables:
 $ foo_1_A : int  0 1 0 0 1
 $ foo_1_B : int  0 0 0 1 1
 $ foo_1_C : int  0 0 0 0 0
 $ foo_1_D : int  1 1 1 1 0
 $ foo_1_E : int  0 0 0 0 0
 $ foo_1_F : int  0 1 0 0 1
 $ foo_2_A : int  1 1 0 1 0
 $ foo_2_B : int  0 1 0 1 1
 $ foo_2_C : int  1 1 0 1 1
 $ foo_2_D : int  1 1 1 0 0
 $ foo_2_E : int  1 0 1 1 0
 $ foo_2_F : int  0 1 1 1 0
 $ foo_3a_A: int  0 1 1 1 1
 $ foo_3a_B: int  1 1 0 1 1
 $ foo_3a_C: int  1 1 0 0 0
 $ foo_3a_D: int  1 1 0 0 1
 $ foo_3a_E: int  1 1 0 0 0
 $ foo_3a_F: int  1 0 1 0 1
 $ foo_3b_A: int  0 0 1 1 0
 $ foo_3b_B: int  0 0 1 1 0
 $ foo_3b_C: int  1 1 1 0 0
 $ foo_3b_D: int  0 0 1 0 0
 $ foo_3b_E: int  0 0 0 1 1
 $ foo_3b_F: int  1 1 0 1 1

我想要的是将 1 重新编码为每一列的选择字母（A、B、C、D、E，或 F) 并连接每个问题的选项，这样我就有这样的东西：

foo_1  D     ADF   D     BD    ABF
foo_2  ACDE  ABCDF DEF   ABCEF BC
foo_3a BCDEF ABCDE AF    AB    ABDF
foo_3b CF    CF    ABCD  ABEF  EF

这是我在意识到我会一遍又一遍地重复类似代码之前所得到的：

df <- df %>% mutate(across(
  starts_with('foo') & ends_with('A'),
  ~ recode(., `1` = 'A', .default = NA_character_)
))

Answer 1

一个选项是使用 pivot_longer 重塑为长格式，然后通过转换将之前生成的序列列分组为 summarise across 'foo' 列它从二进制逻辑，子集 'grp' 列和 paste(str_c) 他们一起

library(dplyr)
library(tidyr)
library(stringr)
df %>%
    mutate(rn = row_number()) %>%
    pivot_longer(cols = -rn, names_to = c(".value", "grp"), 
          names_pattern = "^(.*_.*)_(.*)") %>% 
    group_by(rn) %>%
    summarise(across(-grp, ~ str_c(grp[as.logical(.)], 
          collapse="")), .groups = 'drop') %>% 
    select(-rn)

-输出

# A tibble: 5 x 4
  foo_1 foo_2 foo_3a foo_3b
  <chr> <chr> <chr>  <chr> 
1 D     ACDE  BCDEF  CF    
2 ADF   ABCDF ABCDE  CF    
3 D     DEF   AF     ABCD  
4 BD    ABCEF AB     ABEF  
5 ABF   BC    ABDF   EF

或者另一种选择是

library(purrr)
df %>% 
   summarise(across(everything(), ~case_when(as.logical(.) ~ 
        rep(str_remove(cur_column(), ".*_.*_"), n())))) %>% 
   split.default(str_remove(names(.), "_[^_]+$")) %>%
   map_dfc(~ .x %>%
        unite(new, everything(), na.rm = TRUE, sep="") %>% 
        pull(new)) 
# A tibble: 5 x 4
  foo_1 foo_2 foo_3a foo_3b
  <chr> <chr> <chr>  <chr> 
1 D     ACDE  BCDEF  CF    
2 ADF   ABCDF ABCDE  CF    
3 D     DEF   AF     ABCD  
4 BD    ABCEF AB     ABEF  
5 ABF   BC    ABDF   EF

或使用base R

sapply(split.default(df, sub("(.*_.*)_.*", "\1", names(df))), 
    function(x) apply(x, 1, FUN= function(y) paste(sub(".*_", "", 
     names(y))[as.logical(y)], collapse="")))
    foo_1 foo_2   foo_3a  foo_3b
[1,] "D"   "ACDE"  "BCDEF" "CF"  
[2,] "ADF" "ABCDF" "ABCDE" "CF"  
[3,] "D"   "DEF"   "AF"    "ABCD"
[4,] "BD"  "ABCEF" "AB"    "ABEF"
[5,] "ABF" "BC"    "ABDF"  "EF"

Answer 2

另一种选择是将 dplyr::rowwise 与 dplyover::over 一起使用（免责声明：我是 {dplyover} 的维护者）。 dplyover::cut_names 允许我们 select 我们需要的列名的字符串部分。然后我们可以在 across 中使用它来获取 df 的那些部分，然后我们需要获取 names 并将它们与行数据 as.logical 进行子集化。最后我们需要替换名称，以便只保留最后一个字母。

library(tidyverse)
library(dplyover) # https://github.com/TimTeaFan/dplyover

df %>% rowwise %>% 
  summarise(over(cut_names("_\w$"), ~ 
    unlist(across(starts_with(.x))) %>% 
    {names(.)[as.logical(.)]} %>%  
    {paste(gsub(paste0(.x, "_"), "", .), collapse = "")}
  )) 

#> # A tibble: 5 x 4
#>   foo_1 foo_2 foo_3a foo_3b
#>   <chr> <chr> <chr>  <chr> 
#> 1 D     ACDE  BCDEF  CF    
#> 2 ADF   ABCDF ABCDE  CF    
#> 3 D     DEF   AF     ABCD  
#> 4 BD    ABCEF AB     ABEF  
#> 5 ABF   BC    ABDF   EF

^{由 reprex package (v2.0.1)}

于 2021-09-14 创建

重新编码和折叠多个二进制编码列

recoding and collapasing multiple binary-coded columns

r

multiple-columns

dplyr