Слияние посредством нечеткого сопоставления переменных в R

Question

У меня есть два кадра данных (х и у), где идентификаторы student_name, father_name а также mother_name, Из-за опечаток ("n" вместо "m", случайные пробелы и т. Д.) У меня есть около 60% значений, которые не выровнены, хотя я могу просмотреть данные и увидеть, что они должны. Есть ли способ как-то снизить уровень несоответствия, чтобы вручную редактировать, потому что хотя бы выполнимо? Фреймы данных имеют около 700 тыс. Наблюдений.

R будет лучшим. Я немного знаю Python и некоторые базовые инструменты Unix. PS Я читаю на agrep(), но не понимаю, как это может работать с реальными наборами данных, особенно когда сопоставление выполняется по нескольким переменным.

---

Обновление (данные по объявленной награде):

Вот два примера фреймов данных, sites_a а также sites_b, Они могут быть сопоставлены по числовым столбцам lat а также lon а также на sitename колонка. Было бы полезно узнать, как это можно сделать на lat + lonб) sitename или в) оба.

Вы можете получить файл test_sites.R, который размещен в виде гистограммы.

В идеале ответ должен заканчиваться

merge(sites_a, sites_b, by = **magic**)

Answer 1

agrep Функция (часть базы R), которая выполняет приблизительное сопоставление строк с использованием расстояния редактирования Левенштейна, вероятно, стоит попробовать. Не зная, как выглядят ваши данные, я не могу предложить рабочее решение. Но это предложение... Он записывает совпадения в отдельный список (если есть несколько одинаково хороших совпадений, то они также записываются). Допустим, что ваш data.frame называется df:

l <- vector('list',nrow(df))
matches <- list(mother = l,father = l)
for(i in 1:nrow(df)){
  father_id <- with(df,which(student_name[i] == father_name))
  if(length(father_id) == 1){
    matches[['father']][[i]] <- father_id
  } else {
    old_father_id <- NULL
    ## try to find the total                                                                                                                                 
    for(m in 10:1){ ## m is the maximum distance                                                                                                             
      father_id <- with(df,agrep(student_name[i],father_name,max.dist = m))
      if(length(father_id) == 1 || m == 1){
        ## if we find a unique match or if we are in our last round, then stop                                                                               
        matches[['father']][[i]] <- father_id
        break
      } else if(length(father_id) == 0 && length(old_father_id) > 0) {
        ## if we can't do better than multiple matches, then record them anyway                                                                              
        matches[['father']][[i]] <- old_father_id
        break
      } else if(length(father_id) == 0 && length(old_father_id) == 0) {
        ## if the nearest match is more than 10 different from the current pattern, then stop                                                                
        break
      }
    }
  }
}

Код для mother_name будет в основном то же самое. Вы могли бы даже собрать их вместе в цикле, но этот пример только для иллюстрации.

Answer 2

Это берет список общих имен столбцов, совпадений на основе agrep из всех этих столбцов вместе, а затем, если all.x или же all.y равно TRUE, он добавляет несоответствующие записи, заполняя пропущенные столбцы с помощью NA. В отличие от mergeимена столбцов, с которыми нужно сопоставлять, должны быть одинаковыми в каждом фрейме данных. Казалось бы, проблема заключается в agrep варианты правильно, чтобы избежать ложных совпадений.

  agrepMerge <- function(df1, df2, by, all.x = FALSE, all.y = FALSE, 
    ignore.case = FALSE, value = FALSE, max.distance = 0.1, useBytes = FALSE) {

    df1$index <- apply(df1[,by, drop = FALSE], 1, paste, sep = "", collapse = "")
    df2$index <- apply(df2[,by, drop = FALSE], 1, paste, sep = "", collapse = "")

    matches <- lapply(seq_along(df1$index), function(i, ...) {
      agrep(df1$index[i], df2$index, ignore.case = ignore.case, value = value,
            max.distance = max.distance, useBytes = useBytes)
    })

    df1_match <- rep(1:nrow(df1), sapply(matches, length))
    df2_match <- unlist(matches)

    df1_hits <- df1[df1_match,]
    df2_hits <- df2[df2_match,]

    df1_miss <- df1[setdiff(seq_along(df1$index), df1_match),]
    df2_miss <- df2[setdiff(seq_along(df2$index), df2_match),]

    remove_cols <- colnames(df2_hits) %in% colnames(df1_hits)

    df_out <- cbind(df1_hits, df2_hits[,!remove_cols])

    if(all.x) {
      missing_cols <- setdiff(colnames(df_out), colnames(df1_miss))
      df1_miss[missing_cols] <- NA
      df_out <- rbind(df_out, df1_miss)
    }
    if(all.x) {
      missing_cols <- setdiff(colnames(df_out), colnames(df2_miss))
      df2_miss[missing_cols] <- NA
      df_out <- rbind(df_out, df2_miss)
    }
    df_out[,setdiff(colnames(df_out), "index")]
}