Перекрестное сравнение фреймов данных в R

Question

Я должен сравнить наборы данных двух людей друг с другом.

Допустим, у меня есть фрейм данных с несколькими столбцами a =.

    ID  |     Name        |      Gender      |  Country   
   ——————————————————————————————————————————————————————————
    1   | Mattias Adams   |        M         |    UK           
    2   | James Alan      |        M         |    Canada
    3   | Dana Benton     |        F         |    USA
    4   | Ella Collins    |        F         |    USA

И b =

    ID  | First_Name | Last_name  | Third_name |  Whole_name       |  Gender   
————————————————————————————————————————————————————————————————————————————
    1   |    Gary    |  Cole      |    Allan   | Gary Allan Cole   |    M
    2   |    Dana    |  Benton    |    NA      | Dana Benton       |    F
    3   |    Lena    |  Jamison   |    Anne    | Lena Anne Jamison |    F        
    4   |    Matt    |  King      |    NA      | Matt King         |    M

Фрейм данных a является большим, содержит около 100 000 строк, в то время как b содержит менее 1000.

Цель состоит в том, чтобы использовать данные в b для поиска соответствующих записей в a.Так что вся строка в a возвращается, если есть совпадение.

Я хочу попробовать двумя способами.Сначала найти точные совпадения из b$"Whole_name" в a$"Name".

Точное совпадение:

    eue_wn <- as.character(b$"Whole_name")
    eue_wn_match <- a[which(as.character(a$"Name") %in% eue_wn),]
        if (nrow(eue_wn_match) == 0) {
             eue_wn_match <- "No matches"
        }

Вывод eue_wn_matc в этом случае будет:

    ID  |     Name        |      Gender      |  Country   
   —————————————————————————————————————————————————————————— 
    3   | Dana Benton     |        F         |    USA

Сопоставление с образцом:

    eup_ln <- paste(as.character(b$"Last_name"), collapse = "|")
    eup_fn <- paste(as.character(b$"First_Name"), collapse = "|")
    eup_tn <- paste(as.character(b$"Third_name"), collapse = "|")

    eup_match <- a[which(grepl(eup_ln, as.character(a$"Name"), ignore.case = TRUE)),]         #First filter (last name)
    if (nrow(eup_match) == 0) {
        eup_match <- "No matches"
    } 
    if (nrow(eup_match) > 0) {
        eup_match2 <- eup_match[which(grepl(eup_fn, as.character(eup_match$"Name"), ignore.case = TRUE)),]     #Second filter (first name)
          if (nrow(eup_match2) == 0 ) {
            eup_match2 <- "No matches"
          }
    }

    if (nrow(eup_match2) > 0) {
      eup_match3 <- eup_match2[which(grepl(eup_tn, as.character(eup_match2$"Name"), ignore.case = TRUE)),]     #Third filter (third_name)
      if (nrow(eup_match3) == 0 ) {
        eup_match3 <- "No matches"
      }
    }

Таким образом, в этом процессе сопоставление происходит в 3 этапа.Первый eup_match является результатом поиска фамилии.Затем он берет этот результат и ищет второе совпадение, которое является именем с первым именем. eup_match2 показывает запись, которая соответствует обоим условиям.Наконец, последний результат берется и сопоставляется также с третьим именем eup_match3

, в этом случае результат всех трех из них одинаков:

    ID  |     Name        |      Gender      |  Country   
   —————————————————————————————————————————————————————————— 
    3   | Dana Benton     |        F         |    USA

И этоневерен.Только eup_match и eup_match2 должны иметь этот вывод.Поскольку на первом этапе мы соответствовали Dana Benton(a) и Dana(b) На следующем этапе матч был Dana Benton(a) и Benton (b).А поскольку у нее нет третьего имени, невозможно сопоставить ее с третьим именем.Проблема в:

eup_tn <- paste(as.character(b$"Third_name"), collapse = "|")

Выходные данные:

"Allan|NA|Anne|NA"

Поскольку NA был преобразован в символ, функция смогла найти шаблон в a и b.В данном конкретном случае Dana Benson (a) и NA (b)

Есть идеи, как это исправить?

Другой вопрос связан с выводом.Есть ли способ вывести оба результата из a и b

Пример: если мы сопоставляем только a$Name с b$First_Name по шаблонам, результат будет

ID  |     Name        |      Gender      |  Country   | Match | Match ID
———————————————————————————————————————————————————————————————————————————
1   | Mattias Adams   |        M         |    UK      | Matt  |    4 
3   | Dana Benton     |        F         |    USA     | Dana  |    2

Таким образом, первые 4 столбца взяты из набора данных a, а последние два из b Столбцы Match | Match ID будут отображаться на основе того, какие записи в b были сопоставлены.

Требуемый вывод для приведенного примера теста:

    ID  |     Name        |      Gender      |  Country   
   —————————————————————————————————————————————————————————— 
    3   | Dana Benton     |        F         |    USA

Извините за длинный пост.Я старался сделать это как можно более понятным.Если кто-то захочет воссоздать это, xlsx файлы a и b, а также код r можно найти здесь: MyDropbox

Если у кого-то есть другие предложения о том, как подойтиэта тема может представить их.Спасибо вам за помощь.

Answer 1

Подход № 1: Точное совпадение

Почему бы не что-то вроде

library(stringr)
library(dplyr)
a <- a %>%
    # Extract first and last names into new variables
    mutate(First_Name = str_extract(Name, "^[A-z]+"),
           Last_Name = str_extract(Name, "[A-z]+$"),)

# Inner Join by first and last name.
# Add a suffix to be able to distinguish the origin of columns.
b %>% inner_join(a, by = c("First_Name", "Last_Name"), suffix = c(".b", ".a")) %>%
    # Select the columns you want to see.
    # Note that only the colums that have an ambiguous name have a suffix.
    select(ID.a, Name, Gender.a, Country, First_Name, Last_Name, ID.b)

Отлично работает, если вы ищете только точные совпадения.При желании вы также можете извлечь второе имя из строки через str_extract(string, "[^A-z]+[A-z]+[^A-z$]").

Результат:

  ID.a        Name Gender.a Country First_Name Last_Name ID.b
1    3 Dana Benton        F     USA       Dana    Benton    2

---

Подход № 2: Расстояние до слова (Джаро-Винклер)

Расширение с этого великого поста :

library(RecordLinkage)
library(dplyr)

lookup <- expand.grid(target = a$Name, source = b$Whole_Name, stringsAsFactors = FALSE)

lookup %>% group_by(target) %>%
    mutate(match_score = jarowinkler(target, source)) %>%
    summarise(match = match_score[which.max(match_score)], matched_to = ref[which.max(match_score)]) %>%
    inner_join(b, c("matched_to" = "Whole_Name"))

Все, что выше 0,8 или 0,9 должно быть хорошим соответствием.Все еще не идеально.Вы можете попытаться сопоставить имя и фамилию отдельно, если ваши данные чистые.

Результат:

# A tibble: 4 x 8
  target        match matched_to         ID First_Name Last_Name Third_Name Gender
  <chr>         <dbl> <chr>           <dbl> <chr>      <chr>     <chr>      <chr> 
1 Dana Benton   1     Dana Benton         2 Dana       Benton    NA         F     
2 Ella Collins  0.593 Matt King           4 Matt       King      NA         M     
3 James Alan    0.667 Gary Allan Cole     1 Gary       Cole      Allan      M     
4 Mattias Adams 0.792 Matt King           4 Matt       King      NA         M     

---

Подход № 3: Расстояние до слова (Левенштейн)

То же, что и выше, только с использованием расстояния Левенштейна и which.min()

library(RecordLinkage)
library(dplyr)


lookup <- expand.grid(target = a$Name, source = b$Whole_Name, stringsAsFactors = FALSE)

lookup %>% group_by(target) %>%
    mutate(match_score = levenshteinDist(target, source)) %>%
    summarise(match = match_score[which.min(match_score)], matched_to = ref[which.min(match_score)]) %>%
    inner_join(b, c("matched_to" = "Whole_Name"))

Как и ожидалось, это дает худшую производительность, чем JW.

Результат:

# A tibble: 4 x 8
  target        match matched_to     ID First_Name Last_Name Third_Name Gender
  <chr>         <int> <chr>       <dbl> <chr>      <chr>     <chr>      <chr> 
1 Dana Benton       0 Dana Benton     2 Dana       Benton    NA         F     
2 Ella Collins      9 Dana Benton     2 Dana       Benton    NA         F     
3 James Alan        8 Matt King       4 Matt       King      NA         M     
4 Mattias Adams     8 Matt King       4 Matt       King      NA         M     

---

Данные

a <- structure(list(ID = c(1, 2, 3, 4), Name = c("Mattias Adams", "James Alan", "Dana Benton", "Ella Collins"), Gender = c("M", "M", "F", "F"), Country = c("UK", "Canada", "USA", "USA")), .Names = c("ID", "Name", "Gender", "Country"), row.names = c(NA, -4L), class = "data.frame")
b <- structure(list(ID = c(1, 2, 3, 4), First_Name = c("Gary", "Dana", "Lena", "Matt"), Last_name = c("Cole", "Benton", "Jamison", "King"), Third_Name = c("Allan", "NA", "Anne", "NA"), Whole_name = c("Gary Allan Cole", "Dana Benton", "Lena Anne Jamison", "Matt King"), Gender = c("M", "F", "F", "M")), .Names = c("ID", "First_Name", "Last_Name", "Third_Name", "Whole_Name", "Gender"), row.names = c(NA, -4L), class = "data.frame")

Answer 2

Если вы хотите избежать ложных совпадений с NA, не включайте его в шаблон.Используйте это вместо:

eup_tn <- paste(na.omit(as.character(b$"Third_name")), collapse = "|")

Что касается вашего второго вопроса: это делается с помощью функции merge() в базе R или одной из замен для нее в ?dplyr::join, возможно inner_join().