r - 使用 R 中的 dplyr 库到 "print"非 NA 列的名称

Question

这是我的数据框:

a <- data.frame(id=c(rep("A",2),rep("B",2)),
                x=c(rep(2,2),rep(3,2)),
                p.ABC= c(1,NA,1,1),
                p.DEF= c(NA,1,NA,NA),
                p.TAR= c(1,NA,1,1),
                p.REP= c(NA,1,1,NA),
                p.FAR= c(NA,NA,1,1))

我想创建一个新的字符列(在 R 中的 mutate() 库中使用 dplyr)，它告诉(按行)具有非 NA 值的列的名称(这里的非 NA 值总是1)。但是，它应该只在以“p”开头的列中进行搜索。它应该按字母顺序对名称进行排序，然后使用表达式“_”作为分隔符将它们连接起来。您可以在名为“名称”的列下找到所需的结果:

data.frame(id=c(rep("A",2),rep("B",2)),
                x=c(rep(2,2),rep(3,2)),
                p.ABC= c(1,NA,1,1),
                p.DEF= c(NA,1,NA,NA),
                p.TAR= c(1,NA,1,1),
                p.REP= c(NA,1,1,NA),
                p.FAR= c(NA,NA,1,1),
                name=c("ABC_TAR","DEF_REP","ABC_FAR_REP_TAR","ABC_FAR_TAR"))

我想强调一下，我真的在寻找使用 dplyr 的解决方案。 ，因为没有它我也能做到(但它看起来不漂亮而且很慢)。

Answer 1

这是 tidyverse 的选项，我们用 pivot_longer 将数据 reshape 为“长”格式，按 row_number() 分组), paste删除前缀部分后的列名列“名称”值，然后将该列与原始数据绑定(bind)

library(dplyr)
library(stringr)
library(tidyr)
a %>% 
    mutate(rn = row_number()) %>%
    select(-id, -x) %>%
    pivot_longer(cols = -rn, values_drop_na = TRUE) %>%
    group_by(rn) %>%
    summarise(name = str_c(str_remove(name, ".*\\."), collapse="_"), 
         .groups = 'drop') %>%
    select(-rn) %>% 
    bind_cols(a, .)

-输出

# id x p.ABC p.DEF p.TAR p.REP p.FAR            name
#1  A 2     1    NA     1    NA    NA         ABC_TAR
#2  A 2    NA     1    NA     1    NA         DEF_REP
#3  B 3     1    NA     1     1     1 ABC_TAR_REP_FAR
#4  B 3     1    NA     1    NA     1     ABC_TAR_FAR

或使用 pmap

library(purrr)
a %>% 
   mutate(name = pmap_chr(select(cur_data(), contains('.')), ~ {
       nm1 <- c(...)
       str_c(str_remove(names(nm1)[!is.na(nm1)], '.*\\.'), collapse="_")}))
#  id x p.ABC p.DEF p.TAR p.REP p.FAR            name
#1  A 2     1    NA     1    NA    NA         ABC_TAR
#2  A 2    NA     1    NA     1    NA         DEF_REP
#3  B 3     1    NA     1     1     1 ABC_TAR_REP_FAR
#4  B 3     1    NA     1    NA     1     ABC_TAR_FAR

或使用 apply在 base R

apply(a[-(1:2)], 1, function(x) paste(sub(".*\\.", "", 
        names(x)[!is.na(x)]), collapse="_"))
#[1] "ABC_TAR"         "DEF_REP"         "ABC_TAR_REP_FAR" "ABC_TAR_FAR"