последовательное слияние на основе 4 возможных критериев соответствия в R

Question

У меня есть фрейм данных с именем reference, в котором есть два поля trait1 и trait2. Я хотел бы объединиться в другой фрейм данных to_assign. И reference, и to_assign, имеют два столбца идентификаторов, id.1 и id.2. Я хотел бы выполнить следующее слияние:

1. Объединить вместе, используя столбцы id.1.
2. Для всех записей, которые еще не назначены, объединить to_assign$id.1 и reference$id.2
3. Для всех записей, которые еще не назначены, объединить to_assign$id.2 и reference$id.1
4. Для всех записей, которые еще не назначены, объединить 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)

Я могу сделать это путем выполнения первого слияния, поднабора назначенных и неназначенных записей, удаления столбцов trait.1 и trait.2 из unassigned, повторения слияния между 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.

Answer 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 не любит конфликтующие столбцы

Answer 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'))