在R中判断向量元素是否匹配列表数据框并添加对应列表名列

问题背景 #

现有一个包含N个行列数固定的数据框的列表LIST，部分值为NA；另有一个待检查的DataBase数据框。需要逐行检查DataBase的每行各列元素是否完全匹配LIST中某个数据框的对应位置列的允许值（非NA值需存在于对应列的非NA值中，NA值需对应列存在NA），若找到匹配的数据框则记录其名称，否则标记为No_Match。

示例数据 #

LIST构建代码

A1<-c(1:5)
A2<-c(3)
A3<-c(1:2)
A4<-c(1:3)
A5<-as.integer(c(NA))

length(A1)<-5
length(A2)<-5
length(A3)<-5
length(A4)<-5
length(A5)<-5

DF1 <- data.frame(A1,A2,A3,A4,A5)

B1<-c(4:8)
B2<-c(5)
B3<-c(1:2)
B4<-c(8:12)
B5<-c(1)

length(B1)<-5
length(B2)<-5
length(B3)<-5
length(B4)<-5
length(B5)<-5

DF2 <- data.frame(B1,B2,B3,B4,B5)

LIST <- list(DF1,DF2)
names(LIST) <- c("DF1","DF2")

DataBase构建代码

row1 <- c(4,3,1,3,NA)
row2 <- c(5,5,1,10,1)
row3 <- c(5,2,2,3,NA)

DataBase <- data.frame(rbind(row1,row2,row3))

预期结果

X1 X2 X3 X4 X5    Result
row1  4  3  1  3 NA       DF1
row2  5  5  1 10  1       DF2
row3  5  2  2  3 NA No_Match

解决方案 #

方法一：Base R实现 #

核心思路是先提取每个数据框各列的允许值，再逐行检查匹配情况：

# 1. 提取每个数据框各列的唯一值（含NA）
col_values <- lapply(LIST, function(df) lapply(df, unique))

# 2. 定义单条数据的匹配检查函数
check_match <- function(row, col_val) {
  all(mapply(function(x, vals) {
    if (is.na(x)) {
      # 若当前值是NA，需对应列存在NA
      any(is.na(vals))
    } else {
      # 非NA值需存在于对应列的非NA值中
      x %in% vals[!is.na(vals)]
    }
  }, row, col_val))
}

# 3. 对DataBase逐行匹配，生成结果列
DataBase$Result <- apply(DataBase, 1, function(row) {
  # 检查每行与LIST中每个数据框的匹配情况
  matches <- sapply(names(col_values), function(name) {
    check_match(row, col_values[[name]])
  })
  # 返回第一个匹配的数据框名称，无匹配则返回No_Match
  if (any(matches)) names(matches)[matches][1] else "No_Match"
})

# 查看最终结果
print(DataBase)

方法二：tidyverse实现 #

通过长格式转换实现批量匹配，更适合复杂扩展场景：

library(tidyverse)

# 1. 整理LIST的允许值：数据框名-列-允许值列表
allowed_values <- imap_dfr(LIST, function(df, df_name) {
  df %>%
    pivot_longer(everything(), names_to = "col", values_to = "val") %>%
    group_by(df_name, col) %>%
    summarise(allowed = list(unique(val)), .groups = "drop") %>%
    # 提取列的序号，与DataBase的X1/X2对应
    mutate(col = str_extract(col, "\\d+"))
})

# 2. 转换DataBase为长格式，标记行ID
db_long <- DataBase %>%
  mutate(row_id = rownames(.)) %>%
  pivot_longer(-row_id, names_to = "col", values_to = "val") %>%
  mutate(col = str_extract(col, "\\d+"))

# 3. 匹配并检查每行是否所有列都匹配同一数据框
match_result <- db_long %>%
  left_join(allowed_values, by = "col") %>%
  rowwise() %>%
  mutate(is_match = ifelse(is.na(val), 
                           any(is.na(allowed[[1]])), 
                           val %in% allowed[[1]][!is.na(allowed[[1]])])) %>%
  ungroup() %>%
  group_by(row_id, df_name) %>%
  summarise(all_match = all(is_match), .groups = "drop") %>%
  filter(all_match) %>%
  group_by(row_id) %>%
  summarise(Result = first(df_name, default = "No_Match"), .groups = "drop")

# 4. 合并结果回原DataBase
DataBase <- DataBase %>%
  mutate(row_id = rownames(.)) %>%
  left_join(match_result, by = "row_id") %>%
  select(-row_id)

# 查看最终结果
print(DataBase)

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