使用 R 中的 dplyr 库来“打印”非 NA 列的名称

Question

Here is my data frame:

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))

I Want to create a new character column (using mutate() in the dplyr library in R), which tells (by row) the name of the columns that have a non-NA value (here the non-NA value is always 1). However, it should only search among the columns that start with "p." and it should order the names by alphabetical order and then concatenate them using the expression "_" as a separator. You can find below the desired result, under the column called "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"))

I would like to emphasize that I'm really looking for a solution using dplyr , as I would be able to do it without it (but it doesn't look pretty and it's slow).

Answer 1

Here is an option with tidyverse , where we reshape the data into 'long' format with pivot_longer , grouped by row_number() ), paste the column name column 'name' values after removing the prefix part and then bind that column with the original data

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, .)

-output

# 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

---

Or use 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

---

Or use apply in 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"    

Answer 2

I think my answer may be similar to others, still I feel syntax is written in tidyverse pipe style so may be easier to understand. Still someone, if feels it is copy of theirs, I will be happy to delete it.

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

The idea behind it is actually we can use pipes inside of map/reduce family of functions so as to obviate the necessity of writing a custom function beforehand and also creating intermediate objects inside {}

Answer 3

Using 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                     

Answer 4

Updated Special thanks to dear @akrun for helping me improve my codes: We just made a subtle modification to suppress a message produced by 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