在R中匹配多列指定字符串并将匹配值写入新列

需求说明 #

在数据框中新增一列match，规则如下：

• 若任意code列中存在包含字符串"V"的ICD编码，将该完整编码写入match列（若有多条匹配，取第一条）
• 若无匹配项，match列保留NULL

数据集结构 #

df <- structure(list(ID = c(2L, 7L, 8L, 13L, 15L, 16L, 18L, 25L, 29L, 
35L, 36L, 42L, 44L, 46L, 48L, 49L, 61L, 62L, 64L, 65L), code1 = c("S020XXB", 
"S2243XA", "S32052A", "S069X1A", "S0210XA", "S72331A", "S0264XA", 
"S065X0A", "S066X9A", "S06352A", "S0219XA", "S066X9A", "S8255XA", 
"S02119A", "S36113A", "S065X9A", "S022XXA", "S82102A", "S060X1A", 
"S72451B"), code2 = c("S066X9A", "J9600", "S066X0A", "S42292A", 
"J9601", "S060X9A", "J690", "B1920", "J9601", "J9600", "S066X0A", 
"J9601", "S32591A", "S129XXA", "S270XXA", "I10", "J15211", "J9600", 
"S2242XA", "S065X0A"), code3 = c("S065X9A", "S270XXA", "S37032A", 
"S42425A", "S270XXA", "S42001A", "G92", "V00211A", "J690", "S22069A", 
"F17210", "S82142A", "K760", "S270XXA", "J90", "F17210", "F10121", 
"G9340", "S42032A", "S32461A"), code4 = c("S064X9A", "S069X9A", 
"S52572A", "V4959XA", "S066X5A", "K5900", "Z6843", "Y92838", 
"R6510", "R40243", "R911", "S27329A", "F419", "S27322A", "S060X9A", 
"M542", "M6282", "F10231", "S2231XA", "J9690"), code5 = c("S0102XA", 
"S25391A", "I252", "Y92488", "G931", "S8012XA", "E871", "", "E222", 
"F1010", "S61310A", "S4291XA", "I10", "S22029A", "J9811", "R40241", 
"S02600B", "E440", "V4351XA", "R578"), code6 = c("S82841A", "S3210XA", 
"E039", "", "R1312", "S8011XA", "D62", "", "I480", "H532", "F17290", 
"S2243XA", "S060X0A", "S2232XA", "S0181XA", "Z9114", "E441", 
"N179", "Y92410", "G92"), match = c("NULL", "NULL", "NULL", "NULL", 
"NULL", "NULL", "NULL", "NULL", "NULL", "NULL", "NULL", "NULL", 
"NULL", "NULL", "NULL", "NULL", "NULL", "NULL", "NULL", "NULL"
)), row.names = c(9L, 286L, 363L, 760L, 905L, 909L, 1027L, 1610L, 
1884L, 2072L, 2201L, 3167L, 3367L, 3459L, 3809L, 4052L, 4780L, 
4804L, 4982L, 5009L), class = "data.frame")

指定匹配字符串 #

to_match <- "V"

原始数据示例 #

ID   code1   code2   code3   code4   code5   code6 match
9    2 S020XXB S066X9A S065X9A S064X9A S0102XA S82841A  NULL
286  7 S2243XA   J9600 S270XXA S069X9A S25391A S3210XA  NULL
363  8 S32052A S066X0A S37032A S52572A    I252    E039  NULL
760 13 S069X1A S42292A S42425A V4959XA  Y92488          NULL
905 15 S0210XA   J9601 S270XXA S066X5A    G931   R1312  NULL
909 16 S72331A S060X9A S42001A   K5900 S8012XA S8011XA  NULL

期望效果 #

ID   code1   code2   code3   code4   code5   code6 match
9    2 S020XXB S066X9A S065X9A S064X9A S0102XA S82841A  NULL
286  7 S2243XA   J9600 S270XXA S069X9A S25391A S3210XA  NULL
363  8 S32052A S066X0A S37032A S52572A    I252    E039  NULL
760 13 S069X1A S42292A S42425A V4959XA  Y92488          V4959XA  
905 15 S0210XA   J9601 S270XXA S066X5A    G931   R1312  NULL
909 16 S72331A S060X9A V42001A   K5900 S8012XA S8011XA  V42001A   

解决方案 #

方法1：基础R实现

无需额外包，用apply逐行处理code列，提取匹配项：

# 筛选所有code开头的列
code_cols <- grep("^code", names(df), value = TRUE)

# 逐行提取包含"V"的编码，排除空字符串
df$match <- apply(df[code_cols], 1, function(row) {
  valid_matches <- row[grepl(to_match, row) & row != ""]
  if (length(valid_matches) > 0) valid_matches[1] else NULL
})

方法2：tidyverse框架实现

适合熟悉tidyverse的用户，通过转长-匹配-转宽完成：

library(dplyr)
library(tidyr)

df <- df %>%
  # 添加行号用于分组还原
  mutate(row_id = row_number()) %>%
  # 将所有code列转成纵向格式
  pivot_longer(cols = starts_with("code"), 
               names_to = "code_col", 
               values_to = "code") %>%
  # 标记匹配的编码
  mutate(match = ifelse(grepl(to_match, code) & code != "", code, NA)) %>%
  # 按行分组，提取第一个有效匹配
  group_by(row_id) %>%
  summarise(
    across(-c(code_col, code), first),
    match = first(na.omit(match), default = NULL)
  ) %>%
  # 移除辅助行号，调整列位置
  select(-row_id) %>%
  relocate(match, .after = last_col())

内容的提问来源于stack exchange，提问作者k_grace