在R中使用dplyr库“打印”非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中的库中的)，它按行告诉哪些列的名称具有非NA值(这里非NA值始终为1)。但是，它应该仅在以"p."开头的列中搜索，并按字母顺序排序名称，然后使用" _ "作为分隔符连接它们。您可以在下面找到所需的结果，在名为" name "的列下：

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来解决问题，因为如果不用它，虽然也可以完成任务，但代码看起来不太美观且运行速度较慢。

- Anthony Hauser

Answer 1

这是使用tidyverse的一种选项，我们可以使用pivot_longer将数据重塑为'long'格式，然后按row_number())进行分组，从列名列'value'中删除前缀部分并将其与原始数据绑定。

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

---

或在 base R 中使用 apply

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"    

- akrun

---

谢谢！表达式 str_remove(name, ".*\\.") 究竟是做什么的？ - Anthony Hauser

@AnthonyHauser 这是为了匹配那些前缀为 p. 的字符串，即 .* 前面的 0 或多个字符一直到遇到 . （. 是元字符，用于匹配任何字符，因此我们需要转义），然后将其删除（因为它不在您的期望结果中）。 - akrun

亲爱的Arun，我的代码产生了期望的结果，但是会出现一个消息，指示新名称的命名方式。我想知道如何抑制它或它来自哪里。当我使用pmap时通常会发生这种情况。 - Anoushiravan R

c(...)是什么意思？ - Alvaro Morales

Answer 2

我认为我的答案可能与其他人类似，但是我觉得语法是使用tidyverse管道风格编写的，因此可能更容易理解。如果有人觉得这是他们的副本，我将很乐意删除它。

a %>% mutate(name = pmap(select(cur_data(), contains('p')), 
                         ~ names(c(...))[!is.na(c(...))] %>%
                           str_remove_all(., "p.") %>%
                           paste(., 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

其实，使用管道符号 "|" 可以在 map/reduce 类函数内部进行操作，避免事先编写自定义函数并创建中间对象 {} 的必要性。

- AnilGoyal

---

你是一位了不起的R程序员/用户。没人会想到你已经写了这么多行精彩的代码，其中一些对我来说是难以想象的。 - Anoushiravan R

我们都是这样的 :) - Anoushiravan R

Answer 3

使用rowwise：

library(dplyr)

cols <- grep('^p\\.', names(a), value = TRUE)

a %>%
  rowwise() %>%
  mutate(name = paste0(sub('p\\.', '', 
                cols[!is.na(c_across(starts_with('p')))]), collapse = '_')) %>%
  ungroup

#  id        x p.ABC p.DEF p.TAR p.REP p.FAR name           
#  <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <chr>          
#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                     

- Ronak Shah

---

为什么你需要使用 c_across 而不是 across？ - Anthony Hauser

在使用rowwise时，可以使用 c_across。 - Ronak Shah

Answer 4

更新 特别感谢亲爱的@akrun帮助我改进我的代码： 我们只是对unnest_wider产生的消息进行了微调。

library(dplyr)
library(tidyr)
library(purrr)
library(stringr)

a %>%
  mutate(name = pmap(select(a, starts_with("p.")), ~ {nm1 <- names(c(...))[!is.na(c(...))]; 
  setNames(nm1, seq_along(nm1))})) %>%
  unnest_wider(name) %>%
  rowwise() %>%
  mutate(across(8:11, ~ str_remove(., fixed("p.")))) %>%
  unite(NAME, c(8:11), sep = "_", na.rm = TRUE)

# A tibble: 4 x 8
  id        x p.ABC p.DEF p.TAR p.REP p.FAR NAME           
  <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <chr>          
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

- Anoushiravan R

---

这是来自于 unnest_wider，因为你正在基于该向量创建新列。它会使用 ...1、...2 等来创建新的列名。这只是一个友好的警告。 - akrun

您可以通过将向量命名为 mutate(name = pmap(select(a, starts_with("p.")), ~ {nm1 <- names(c(...))[!is.na(c(...))]; setNames(nm1, seq_along(nm1))})) %>% 来解决该问题。 - akrun

是的，当我们有多个表达式时，我们使用 {}。这与 for 循环中的用法相同，例如 for(i in 1:10) print('hello') 不需要 {}，因为它是单个表达式。 - akrun

每次都是很棒的学习机会。我也正在尝试着动手去做。 - AnilGoyal

@AnilGoyal 我完全同意你的观点。 - Anoushiravan R