如何基于前缀匹配合并表格？求tidyverse与base R实现方法

我有一个含前缀映射的CSV表格：

PREFIX,LABEL
A,Infectious diseases
B,Infectious diseases
C,Tumor
D1,Tumor
D2,Tumor
D31,Tumor
D32,Tumor
D33,Blood disorder
D4,Blood disorder
D5,Blood disorder

需要将它和下面的表格合并：

AGE,DEATH_CODE
67,A02
85,D318
75,C007+X
62,D338

预期得到结果：

AGE,LABEL
67,Infectious diseases
85,Tumor
75,Tumor
62,Blood disorder

我知道用SQL结合LIKE可以实现，但不知道怎么用tidyverse的left_join或者base R完成。

数据dput结果 #

表格1：CIM_CODES

structure(list(PREFIX = c("A", "B", "C", "D1", "D2", "D31", "D32", 
"D33", "D4", "D5"), LABEL = c("Infectious diseases", "Infectious diseases", 
"Tumor", "Tumor", "Tumor", "Tumor", "Tumor", "Blood disorder", 
"Blood disorder", "Blood disorder")), row.names = c(NA, -10L), spec = structure(list(
    cols = list(PREFIX = structure(list(), class = c("collector_character", 
    "collector")), LABEL = structure(list(), class = c("collector_character", 
    "collector"))), default = structure(list(), class = c("collector_guess", 
    "collector")), delim = ","), class = "col_spec"), problems = <pointer: 0x000002527d306190>, class = c("spec_tbl_df", 
"tbl_df", "tbl", "data.frame"))

表格2：DEATH_CAUSES

structure(list(AGE = c(67, 85, 75, 62), DEATH_CODE = c("A02", 
"D318", "C007+X", "D338")), row.names = c(NA, -4L), spec = structure(list(
    cols = list(AGE = structure(list(), class = c("collector_double", 
    "collector")), DEATH_CODE = structure(list(), class = c("collector_character", 
    "collector"))), default = structure(list(), class = c("collector_guess", 
    "collector")), delim = ","), class = "col_spec"), problems = <pointer: 0x0000025273898c60>, class = c("spec_tbl_df", 
"tbl_df", "tbl", "data.frame"))

方法一：tidyverse 实现 #

核心思路是先从DEATH_CODE中提取能匹配PREFIX的最长前缀，再用left_join关联标签。

library(tidyverse)

# 加载数据
CIM_CODES <- structure(list(PREFIX = c("A", "B", "C", "D1", "D2", "D31", "D32", "D33", "D4", "D5"), LABEL = c("Infectious diseases", "Infectious diseases", "Tumor", "Tumor", "Tumor", "Tumor", "Tumor", "Blood disorder", "Blood disorder", "Blood disorder")), row.names = c(NA, -10L), class = c("spec_tbl_df", "tbl_df", "tbl", "data.frame"))
DEATH_CAUSES <- structure(list(AGE = c(67, 85, 75, 62), DEATH_CODE = c("A02", "D318", "C007+X", "D338")), row.names = c(NA, -4L), class = c("spec_tbl_df", "tbl_df", "tbl", "data.frame"))

# 提取最长匹配前缀并关联标签
result <- DEATH_CAUSES %>%
  mutate(
    # 找出当前DEATH_CODE匹配的所有PREFIX，取最长的那个
    PREFIX = map_chr(DEATH_CODE, ~ {
      matches <- str_subset(CIM_CODES$PREFIX, str_c("^", .x)) %>% 
        nchar() %>% 
        which.max() %>% 
        CIM_CODES$PREFIX[.]
    })
  ) %>%
  left_join(CIM_CODES, by = "PREFIX") %>%
  select(AGE, LABEL)

print(result)

运行结果：

# A tibble: 4 × 2
    AGE LABEL                
  <dbl> <chr>                
1    67 Infectious diseases  
2    85 Tumor                
3    75 Tumor                
4    62 Blood disorder       

方法二：base R 实现 #

用sapply匹配最长前缀，再通过merge合并数据。

# 加载数据
CIM_CODES <- structure(list(PREFIX = c("A", "B", "C", "D1", "D2", "D31", "D32", "D33", "D4", "D5"), LABEL = c("Infectious diseases", "Infectious diseases", "Tumor", "Tumor", "Tumor", "Tumor", "Tumor", "Blood disorder", "Blood disorder", "Blood disorder")), row.names = c(NA, -10L), class = c("spec_tbl_df", "tbl_df", "tbl", "data.frame"))
DEATH_CAUSES <- structure(list(AGE = c(67, 85, 75, 62), DEATH_CODE = c("A02", "D318", "C007+X", "D338")), row.names = c(NA, -4L), class = c("spec_tbl_df", "tbl_df", "tbl", "data.frame"))

# 定义匹配最长前缀的函数
match_longest_prefix <- function(code, prefixes) {
  matches <- prefixes[startsWith(code, prefixes)]
  if (length(matches) == 0) return(NA)
  # 按长度降序排序，取第一个
  matches[order(nchar(matches), decreasing = TRUE)][1]
}

# 为每个DEATH_CODE匹配前缀
DEATH_CAUSES$PREFIX <- sapply(DEATH_CAUSES$DEATH_CODE, match_longest_prefix, prefixes = CIM_CODES$PREFIX)

# 合并并筛选列
result <- merge(DEATH_CAUSES, CIM_CODES, by = "PREFIX", all.x = TRUE)[, c("AGE", "LABEL")]

print(result)

运行结果：

AGE                LABEL
1  67 Infectious diseases
2  75                Tumor
3  85                Tumor
4  62      Blood disorder

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