努力寻找一个优雅的解决方案…
我有对“请选择所有适用的”问题的回答，其中每个问题的选项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_)
))
一种选择是使用pivot_longer重塑为长格式，然后通过先前生成的序列列进行分组，通过将其从二进制转换为逻辑列来跨foo列汇总，子集'grp'列并粘贴（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"
另一种选择是使用dplyr::rowwise和dplyover::over（免责声明：我是{dplyover}的维护者）。dplyover::cut_names允许我们选择我们需要的列名的字符串部分。然后我们可以在中跨使用它来获取df中我们需要的部分，然后获取名称并用行数据作为.逻辑对它们进行子集。最后我们需要替换名称，以便只保留最后一个字母。
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包（v2.0.1）于2021-09-14创建
