根据 R 中的 4 个可能的匹配条件顺序合并答案

【问题标题】：sequentially merging based on 4 possible match criteria in R根据 R 中的 4 个可能的匹配条件顺序合并
【发布时间】：2019-03-04 06:25:28
【问题描述】：

我有一个名为reference 的数据框，它有两个字段trait1 和trait2 我想合并到另一个数据框to_assign。 reference 和 to_assign 都有两个标识符列，id.1 和 id.2。我想执行以下合并：

使用id.1 列合并在一起。
对于所有仍未分配的条目，合并to_assign$id.1 和reference$id.2
对于所有仍未分配的条目，合并to_assign$id.2 和reference$id.1
对于所有仍未分配的条目，合并to_assign$id.2 和reference$id.2

这是生成这些数据帧的代码：

id.1 <- LETTERS[1:10]
id.2 <- LETTERS[6:15]
trait1 <- rbinom(length(id.1),1,0.5)
trait2 <- rbinom(length(id.1),1,0.5)
reference <- data.frame(id.1,id.2,trait1,trait2)

id.1 <- LETTERS[runif(100,1,26)]
id.2 <- LETTERS[runif(100,1,26)]
to_assign <- data.frame(id.1,id.2)

我可以通过执行第一次合并、对已分配和未分配的条目进行子集化、从 unassigned 中删除列 trait.1 和 trait.2、使用第二个合并标准重复 unassigned 和 reference 之间的合并来做到这一点，然后调用rbind(assigned,unassigned)，冲洗并重复合并标准3和4。这是执行此操作的代码，这会生成我想要的输出为out：

#merge 1.
out <- merge(to_assign, reference[,c('id.1','trait1','trait2')], all.x=T)
#merge 2.
  assigned <- out[!is.na(out$trait1),]
unassigned <- out[ is.na(out$trait1),]
unassigned$trait1 <- NULL
unassigned$trait2 <- NULL
unassigned <- merge(unassigned, reference[,c('id.2','trait1','trait2')], by.x = 'id.1', by.y='id.2', all.x=T)
out <- rbind(assigned, unassigned)
#merge 3.
  assigned <- out[!is.na(out$trait1),]
unassigned <- out[ is.na(out$trait1),]
unassigned$trait1 <- NULL
unassigned$trait2 <- NULL
unassigned <- merge(unassigned, reference[,c('id.1','trait1','trait2')], by.x = 'id.2', by.y='id.1', all.x=T)
out <- rbind(assigned, unassigned)
#merge 4.
  assigned <- out[!is.na(out$trait1),]
unassigned <- out[ is.na(out$trait1),]
unassigned$trait1 <- NULL
unassigned$trait2 <- NULL
unassigned <- merge(unassigned, reference[,c('id.2','trait1','trait2')], all.x=T)   
out <- rbind(assigned, unassigned)

但是，这似乎让人头疼，而且我有很多参考数据框需要以这种方式合并。我正在寻找一种更简单的方法来做到这一点，并且每个参考数据帧合并不需要约 20 行代码。我在编写一个函数来执行此操作时遇到问题，因为该函数需要处理引用数据帧，这些数据帧的列名可能不同于 trait1 和 trait2，并且可能超过 2 个。

【问题讨论】：

标签： r merge

【解决方案1】：

也许这对你有用，使用我的包safejoin，它包装了包dplyr和fuzzyjoin中的函数：

# devtools::install_github("moodymudskipper/safejoin")
library(safejoin)
debugonce(safe_left_join)
res <- safe_left_join(to_assign, reference, check ="", ~
                 X("id.1") == Y("id.1") | 
                 X("id.1") == Y("id.2") |
                 X("id.2") == Y("id.1") |
                 X("id.2") == Y("id.2"))

head(res,15)
#    id.1.x id.2.x id.1.y id.2.y trait1 trait2
# 1       J      O      E      J      0      0
# 2       J      O      J      O      0      0
# 3       C      A      A      F      0      1
# 4       C      A      C      H      0      0
# 5       C      W      C      H      0      0
# 6       C      L      C      H      0      0
# 7       C      L      G      L      0      1
# 8       I      W      D      I      0      1
# 9       I      W      I      N      1      0
# 10      C      C      C      H      0      0
# 11      L      E      E      J      0      0
# 12      L      E      G      L      0      1
# 13      W      S   <NA>   <NA>     NA     NA
# 14      P      S   <NA>   <NA>     NA     NA
# 15      T      D      D      I      0      1

check="" 使其安静，因为默认情况下 safejoin 不喜欢列冲突

【讨论】：

【解决方案2】：

这是一个潜在的函数，它返回与上述问题中约 20 行代码相同的结果。但是，它并不是最漂亮的功能，我仍在寻找更好的解决方案。

super_merge <- function(d1, d2, merge.columns = c('id.1','id.2')){
  ref_names <- colnames(d2)[!(colnames(d2) %in% merge.columns)]
  #merge 1.
  out <- merge(d1,d2[, !(colnames(d2) %in% merge.columns[2])], all.x=T)
  #merge 2.
  to_check <- colnames(out)[colnames(out) %in% ref_names[1]]
    assigned <- out[!is.na(out[,to_check]),]
  unassigned <- out[ is.na(out[,to_check]),]
  unassigned[,ref_names] = NULL
  unassigned <- merge(unassigned,d2[, !(colnames(d2) %in% merge.columns[1])], 
                      by.x = merge.columns[1], by.y = merge.columns[2], all.x = T)
  out <- rbind(assigned,unassigned)
  #merge 3.
  assigned <- out[!is.na(out[,to_check]),]
  unassigned <- out[ is.na(out[,to_check]),]
  unassigned[,ref_names] = NULL
  unassigned <- merge(unassigned,d2[, !(colnames(d2) %in% merge.columns[2])], 
                      by.x = merge.columns[2], by.y = merge.columns[1], all.x = T)
  out <- rbind(assigned,unassigned)
  #merge 4.
  assigned <- out[!is.na(out[,to_check]),]
  unassigned <- out[ is.na(out[,to_check]),]
  unassigned[,ref_names] = NULL
  unassigned <- merge(unassigned,d2[, !(colnames(d2) %in% merge.columns[1])], 
                      by.x = merge.columns[2], by.y = merge.columns[2], all.x = T)
  out <- rbind(assigned,unassigned)
  #return output.
  return(out)
}

执行函数为：

output <- super_merge(to_assign,reference,merge.columns=c('id.1','id.2'))

【讨论】：