R中与顺序无关的字符串匹配

时间:2019-02-25 16:21:29

标签: r string matching fuzzy stringdist

我试图将表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 :(得分:0)

我发现,有了很多数据,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