在 R 中查找字符串的部分匹配项

Question

我有一个非常大的数据库，其名称如下：

names <- c("William Gates", "Bill Gates", "Gates, William H. III", 
    "Gates, William III", "William H Gates", "William H. Gates", 
    "Carlos Slim Helu & family", "Carlos Slim Helu", 
    "Carlos Slim & Family", "Carlos Slim")

我想像这样自动“清理”：

new_names <- c("William Gates", "William Gates", "William Gates", 
    "William Gates", "William Gates", "William Gates", 
    "Carlos Slim Helu & family", "Carlos Slim Helu & family", 
    "Carlos Slim Helu & family", "Carlos Slim Helu & family")

我（任意）使用名称的第一次出现来替换它的其他变体。

在这个例子中，names 是一个长度为 10 的字符向量。我想创建一个“部分匹配值”的10 X 10 矩阵。该矩阵将存储部分匹配范围的 0 到 1 之间的“度量”。例如，将names[1] 与names[1] 进行比较会产生完美匹配，因此值为1；比较names[1] 和names[2] 会得到类似5/12 = 0.41667 的结果，这反映了Gates 对两个字符串都是通用的并且（忽略空字符串）names[1] 有12 个字母；按照同样的逻辑，将names[2] 与names[1] 进行比较会得到类似5/9 = 0.55556 的结果。

我可能会忽略大小写（family 和 Family 将是完美匹配），只关注匹配子字符串（但如果有人对如何匹配有意见，比如 Slim 和 Silm，那也很好。

作为第二步，我将创建一个最大值的三角矩阵（在示例中，值 5/9 = 0.55556）。然后，我将使用此矩阵来观察情况并选择一个阈值，例如 0.95，高于该阈值的字符串被替换，逐渐降低阈值，直到我对数据已被清理感到满意为止。

我希望以前有人做过这种事情，并且有人能够帮助我开始。我已经阅读了 Paul Murrell 的 compare 包，并希望它是一个很好的工具，但是我没有看到太多可以很容易适应的示例，所以如果您知道教程或包以外的示例小插图，请给我指点。

我确实意识到一个好问题需要更多的代码，我很抱歉不能提供太多。虽然我对 R 相当熟悉，但我并不熟悉字符串匹配。如果有人指点我开始的某个地方，我可以尝试用一些示例代码重新表述我的问题。

Answer 1

基于adist 和聚类的完整答案。

使用参数partial=TRUE 和ignore.case=TRUE，函数 来自基础R 的adist 似乎可以解决这个问题。长久以来 运输，Chris S 指出的图书馆stringdist 似乎 很有希望，但也可以使用这种方法。

此解决方案通过hclust 使用集群，采用“单一链接” 采用“朋友的朋友”方法的方法 解决这个问题。

请注意，这需要根据集群高度选择阈值 （在这种情况下，累积广义 Levenshtein 距离 通过单链接标准查看的名称）。如果集群不是太 比可视化或检查输出的问题更昂贵 hclust 也不应该太糟糕。

 ## renamed to avoid overwriting names() function
  raw_names <- c("William Gates", "Bill Gates", "Gates, William H. III", 
      "Gates, William III", "William H Gates", "William H. Gates", 
      "Carlos Slim Helu & family", "Carlos Slim Helu", 
      "Carlos Slim & Family", "Carlos Slim")

 lev_dist <- adist(raw_names, raw_names, partial=TRUE, ignore.case=TRUE)

 #use single linkage method as it suits the problem
 hc <- hclust(as.dist(lev_dist), method='single')

 ## cluster vis for picking threshold
 plot(hc, labels=raw_names)
 threshold <- 6 ## in terms of cluster height --

 ## based on threshold, get clusters and make labels
 cluster <- cutree(hc, h=threshold)
 cluster_labels <- sapply(unique(cluster), function(i) raw_names[min(which(cluster == i))])
 (new_names <- cluster_labels[cluster])

 ##  [1] "William Gates" "William Gates" "William Gates"
 ## "Carlos Slim Helu & family" "Carlos Slim Helu & family" [6]
 ## "William Gates" "William Gates" "William Gates"
 ## "Carlos Slim Helu & family" "Carlos Slim Helu & family"

Answer 2

这是一个简单的尝试。只是使用内置函数而不创建任何矩阵，但它似乎适用于这个简单的示例。

names <- c("William Gates", "Bill Gates", "Gates, William H. III", 
           "Gates, William III", "William H Gates", "William H. Gates", 
           "Carlos Slim Helu & family", "Carlos Slim Helu", 
           "Carlos Slim & Family", "Carlos Slim")

new_names <- c("William Gates", "William Gates", "William Gates", 
               "William Gates", "William Gates", "William Gates", 
               "Carlos Slim Helu & family", "Carlos Slim Helu & family", 
               "Carlos Slim Helu & family", "Carlos Slim Helu & family")

nn <- c('Bill Gates','Carlos Slim')


cbind(names, sapply(nn, function(x) 
  ifelse(agrepl(x, names, max.distance = 5), x, NA)))

#      names                       Bill Gates   Carlos Slim  
# [1,] "William Gates"             "Bill Gates" NA           
# [2,] "Bill Gates"                "Bill Gates" NA           
# [3,] "Gates, William H. III"     "Bill Gates" NA           
# [4,] "Gates, William III"        "Bill Gates" NA           
# [5,] "William H Gates"           "Bill Gates" NA           
# [6,] "William H. Gates"          "Bill Gates" NA           
# [7,] "Carlos Slim Helu & family" NA           "Carlos Slim"
# [8,] "Carlos Slim Helu"          NA           "Carlos Slim"
# [9,] "Carlos Slim & Family"      NA           "Carlos Slim"
# [10,] "Carlos Slim"               NA           "Carlos Slim"

编辑

names <- c("William Gates", "Bill Gates", "Gates, William H. III", 
           "Gates, William III", "William H Gates", "William H. Gates", 
           "Carlos Slim Helu & family", "Carlos Slim Helu", 
           "Carlos Slim & Family", "Carlos Slim")

names <- gsub('[[:punct:]]', '', names)
nn <- sort(table(unlist(strsplit(names, ' '))))
nn <- names(nn[nn >= 4])

cbind(names, sapply(nn, function(x) 
  ifelse(agrepl(x, names, max.distance = 1), x, NA)))

#      names                      Carlos   Slim   William   Gates  
# [1,] "William Gates"            NA       NA     "William" "Gates"
# [2,] "Bill Gates"               NA       NA     NA        "Gates"
# [3,] "Gates William H III"      NA       NA     "William" "Gates"
# [4,] "Gates William III"        NA       NA     "William" "Gates"
# [5,] "William H Gates"          NA       NA     "William" "Gates"
# [6,] "William H Gates"          NA       NA     "William" "Gates"
# [7,] "Carlos Slim Helu  family" "Carlos" "Slim" NA        NA     
# [8,] "Carlos Slim Helu"         "Carlos" "Slim" NA        NA     
# [9,] "Carlos Slim  Family"      "Carlos" "Slim" NA        NA     
# [10,] "Carlos Slim"              "Carlos" "Slim" NA        NA   

Answer 3

stringdist 包可能有助于获取矩阵 - 它也在 2014 年 6 月 R journal 中进行了描述。更新：其中一种 qgram 方法可能对姓氏、名字或名字都最有效

library(stringdist)
stringdistmatrix(names, names, "jaccard")
        [,1]  [,2]  [,3]  [,4]   [,5]   [,6]  [,7]  [,8]  [,9] [,10]
 [1,] 0.0000 0.273 0.286 0.167 0.0909 0.1667 0.632 0.562 0.647 0.571
 [2,] 0.2727 0.000 0.467 0.385 0.3333 0.3846 0.684 0.625 0.706 0.643
 [3,] 0.2857 0.467 0.000 0.143 0.2143 0.1429 0.636 0.579 0.714 0.667
 [4,] 0.1667 0.385 0.143 0.000 0.2308 0.2857 0.667 0.611 0.684 0.625
 [5,] 0.0909 0.333 0.214 0.231 0.0000 0.0833 0.579 0.500 0.667 0.600
 ...