使用 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 中dplyr庫中的mutate() ），它告訴（按行）具有非 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 的一個選項，我們使用tidyverse將數據重塑為“long”格式，按pivot_longer row_number()分組），在刪除前綴部分后paste列名列“name”值，然后將該列與原始數據綁定

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"    

Answer 2

我認為我的答案可能與其他人相似，但我仍然覺得語法是用tidyverse pipe 風格編寫的，所以可能更容易理解。 還有人，如果覺得它是他們的副本，我會很樂意刪除它。

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 系列函數中使用管道，從而避免事先編寫自定義 function 並在{}中創建中間對象的必要性

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                     

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