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

Question

努力寻找一个优雅的解决方案......
我有对“请选择所有适用”问题的回答，其中每个问题的每个选项 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 reshape 为长格式然后按之前生成的序列列分组到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"