Заказать независимое сопоставление строк в R - PullRequest
Новая
       44

Заказать независимое сопоставление строк в R

0 голосов
/ 25 февраля 2019

Я пытаюсь сопоставить имена в таблице A с именами, присутствующими в основной таблице.Порядок имен, представленных в Таблице A, не совсем в согласованном формате, что означает, что не обязательно имя будет начинаться с имени, оно все случайное, в некоторых случаях оно может начинаться и с фамилии.

Иллюстрация: 

#Table A
word <- c("PILLAY NOLAN VICTOR", "PILLAY NICHOLAS")
#Master Table
choices <- c("IGOR JOSE VICTOR","WILLIAM NICHOLAS","NOLAN PILLAY","NICHOLAS PILLAY")

Выполнение приведенного ниже кода: 

data <- NULL

    df <- foreach(a = idivix(length(word),chunks = no_cores),  .combine = "rbind", .packages = 'stringdist') %dopar% {
      do.call('rbind', lapply(seq(a$i,length.out = a$m), function(i)
      {
        tryCatch({
          #library(stringdist)
          d = expand.grid(word[i],choices)
          names(d) <- c("traveler_names","people_name")
          d$dist <-stringdist(d$traveler_names,d$people_name, method = "lv")
          d <- d[order(d$dist),]
          d <- d[1,]
          data<-rbind(data,d)
        }, error=function(e){})
      }))
    }

возвращает следующее совпадение: 

traveler name           people name          dist
PILLAY NOLAN VICTOR     IGOR JOSE VICTOR     10
PILLAY NICHOLAS         WILLIAM NICHOLAS      3

вместо сопоставления с "NOLAN"PILLAY "&" NICHOLAS PILLAY "из-за зависимости порядка при сопоставлении строк.

Есть ли какой-либо способ получить желаемый результат в R, в основном сопоставление строк, не зависящее от порядка?Буду очень признателен за помощь ...

1 Ответ

0 голосов
/ 25 февраля 2019

Я обнаружил, что при большом количестве данных функция stringdist может зависнуть.Таким образом, если у вас возникают проблемы со скоростью, есть другие опции для пакетов (например, пакет RecordLinkage, agrep) и другие методы для сопоставления строк (т. Е. Другие меры расстояния).Кроме того, не на 100% ясно, что вы спрашиваете, но если ваша проблема заключается в том, что вы хотите проверить, чтобы перевернуть имена и фамилии, вы всегда можете использовать strsplit. Например, 

> library(stringdist)
> 
> #Table A
> word <- c("PILLAY NOLAN VICTOR", "PILLAY NICHOLAS")
> #Master Table
> choices <- c("IGOR JOSE VICTOR","WILLIAM NICHOLAS","NOLAN PILLAY","NICHOLAS PILLAY")
> 
> # Try # 1
> match_dist <- sapply(word,
+        function(x) min(stringdist(x, choices, method = "lv")))
> 
> match_text <- sapply(word,
+        function(x) choices[which.min(stringdist(x, choices, method = "lv"))])
> 
> df <- data.frame("traveler name" = word,
+                  "people name" = match_text, 
+                  "dist" = match_dist, stringsAsFactors = FALSE, row.names = NULL)
> # Checking results
> df
        traveler.name      people.name dist
1 PILLAY NOLAN VICTOR IGOR JOSE VICTOR    9
2     PILLAY NICHOLAS WILLIAM NICHOLAS    3
> 
> 
> # Reversing srings, assuming names are sepearated by a space
> reversed <- sapply(strsplit(choices, " "), function(x) paste(rev(x), collapse=" ")) #reversing words
> choices <- c(choices, reversed)
> choices <- unique(choices)
> 
> 
> # Try # 2
> match_dist <- sapply(word,
+                      function(x) min(stringdist(x, choices, method = "lv")))
> 
> match_text <- sapply(word,
+                      function(x) choices[which.min(stringdist(x, choices, method = "lv"))])
> 
> df <- data.frame("traveler name" = word,
+                  "people name" = match_text, 
+                  "dist" = match_dist, stringsAsFactors = FALSE, row.names = NULL)
> 
> # Checking the new results
> df
        traveler.name     people.name dist
1 PILLAY NOLAN VICTOR    PILLAY NOLAN    7
2     PILLAY NICHOLAS PILLAY NICHOLAS    0

В зависимости откак ваши данные настроены, вы можете найти полезным (или нет) избавиться от отчеств или очистить данные другими способами, но это должно помочь вам начать.

РЕДАКТИРОВАТЬ:

Я протестировал несколько различных решений, но не тестировал agrep, так что, возможно, стоит проверить.Я бы определенно высказался за RecordLinkage, и я бы даже рассмотрел возможность разбить ваш набор данных на идеальные совпадения и несовпадения, а затем только обратить (или отсортировать) несоответствия.Код будет узким местом при расчете меры расстояния, поэтому все, что нужно для сокращения числа имен, нуждающихся в измерении расстояния, вероятно, поможет вам.

> library(stringdist)
> library(RecordLinkage)
> library(microbenchmark)
> 
> #Table A
> word <- c("PILLAY NOLAN VICTOR", "PILLAY NICHOLAS", "WILLIAM NICHOLAS")
> #Master Table
> choices <- c("IGOR JOSE VICTOR","WILLIAM NICHOLAS","NOLAN PILLAY","NICHOLAS PILLAY")
> 
> microbenchmark({
+ 
+ # All reversed
+ reversed <- sapply(strsplit(choices, " "), function(x) paste(rev(x), collapse=" ")) #reversing words
+ choices1 <- c(choices, reversed)
+ choices1 <- unique(choices1)
+ 
+ match_dist <- sapply(word, function(x) min(stringdist(x, choices1, method = "lv")))
+ match_text <- sapply(word, function(x) choices1[which.min(stringdist(x, choices1, method = "lv"))])
+ 
+ df1 <- data.frame("traveler name" = word, 
+                  "people name" = match_text,
+                  "dist" = match_dist, 
+                  stringsAsFactors = FALSE, row.names = NULL)
+ }, 
+ 
+ {
+ # Record linkage
+ reversed <- sapply(strsplit(choices, " "), function(x) paste(rev(x), collapse=" ")) #reversing words
+ choices2 <- c(choices, reversed)
+ choices2 <- unique(choices2)
+   
+ match_dist2 <- sapply(word, function(x) min(levenshteinDist(x, choices2)))
+ match_text2 <- sapply(word, function(x) choices2[which.min(levenshteinDist(x, choices2))])
+   
+ df2 <- data.frame("traveler name" = word, 
+                   "people name" = match_text2,
+                   "dist" = match_dist2, 
+                   stringsAsFactors = FALSE, row.names = NULL)
+ },
+ 
+ {
+ # Sorted
+ 
+ sorted <- sapply(strsplit(choices, " "), function(x) paste(sort(x), collapse=" ")) #sorting choices
+ choices3 <- c(choices, sorted)
+ choices3 <- unique(choices3)
+ word3 <- sapply(strsplit(word, " "), function(x) paste(sort(x), collapse=" ")) #sorting words
+ 
+ match_dist3 <- sapply(word3, function(x) min(stringdist(x, choices3, method = "lv")))
+ match_text3 <- sapply(word3, function(x) choices3[which.min(stringdist(x, choices3, method = "lv"))])
+ 
+ df3 <- data.frame("traveler name" = word3, 
+                   "people name" = match_text3,
+                   "dist" = match_dist3, 
+                   stringsAsFactors = FALSE, row.names = NULL)
+ },
+ times = 1)
Unit: milliseconds


    expr          min       lq     mean   median       uq      max neval
revers     6.627258 6.627258 6.627258 6.627258 6.627258 6.627258     1
reversRL   4.016632 4.016632 4.016632 4.016632 4.016632 4.016632     1
sort       7.223453 7.223453 7.223453 7.223453 7.223453 7.223453     1
> 
> all.equal(df1, df2)
[1] TRUE
> 
> df2
        traveler.name      people.name dist
1 PILLAY NOLAN VICTOR     PILLAY NOLAN    7
2     PILLAY NICHOLAS  PILLAY NICHOLAS    0
3    WILLIAM NICHOLAS WILLIAM NICHOLAS    0
> df3
        traveler.name      people.name dist
1 NOLAN PILLAY VICTOR     NOLAN PILLAY    7
2     NICHOLAS PILLAY  NICHOLAS PILLAY    0
3    NICHOLAS WILLIAM NICHOLAS WILLIAM    0
...