通过R中的模糊多对一字符串匹配来匹配两个数据集

Question

我有两个大的数据集（每个500k obs），我想通过模糊字符串匹配个人的名字，但也利用其他变量的信息。问题类似于这里描述的问题：How can I match fuzzy match strings from two datasets?

但是，在那里发布的解决方案需要首先通过expand.grid生成所有成对的潜在匹配，但是我的数据无法完成。如果您有两个10,000 obs的数据集，那么这将导致100,000,000个潜在成对匹配的总数据集。

我想首先产生一对一的合并，其中来自数据集A的观察$ k $与来自数据集B的5个最接近匹配的观察结果（由Jaro Winkler字符串距离判断）匹配，这些观察结果属于某个年龄段，比如加/减5年。

例如，如果数据A中的$ k $是

name          birthyear
John Smith    1984

以及数据集B中的其他观察结果

serial   name           birthyear
1        John Smith     1983
2        Sara Pinkert   1973
3        John Smyth     1999
4        John Smithe    1985
5        John Smith     1984
6        Jon Smith      1984

那么$ k $的5个“最佳”匹配与数据B中的观察结果应该是1号，4号，5号，6个生育年限制为+ - 5年。在这种情况下没有。 2（Sara Pinkert）由于名称不匹配，并且没有。 3（约翰史密斯）不应该匹配，因为这个观察的出生年份为时已晚。

由fastLink，stringdist或recordLinkage等其他图书馆提供的功能和命令既好又快，但它们总是只产生一对一的匹配（而且它们很少能够整合出生年份的信息以限制维度匹配问题）。

到目前为止我能够弄清楚的关闭解决方案是使用来自compare.linkage的recordLinkage函数，但阻塞选项（blockfld）似乎严格阻止特定变量，因此不能明白如何使用出生年份信息的范围：

rpairs = compare.linkage(dataA, 
                     dataB, 
                     blockfld = c("birthyear"), 
                     identity1 = dataA$id1, 
                     identity2 = dataB$id2, 
                     n_match = 5, 
                     strcmpfun = jarowinkler)

但是这只能在完美的分娩期间阻止，因此它将返回两场比赛，这将是没有。 5和6（John Smith 1984，Jon Smith 1984）。

以下是匹配问题的一些示例数据。由于体积小，看起来似乎微不足道，但在整个样本中每个有50万个障碍物（其中一些出现在一个但不出现在其他数据中，有些出现在两者中，但可能在其名称中有拼写错误），这更加棘手。

name1 = c("John Smith", "Adam Bower", "Felix von Epstein", "Charles Sawyer", "Benjamin Hoynes")
yob1 = c(1980, 1977, 1981, 1981, 1978)
dataA = data.frame(name1, yob1)

name2 = c("Jon Smyth", "Perry Bower", "Felix Epstein", "Terry Barnes", "John Smith", "Benamin Hoynes", "Frank Sawyer", "Charles Sawer", "Charles Sauer", "Philip Smith", "Franklin Sawyer", "Jonathan Smith", "Gabriel Bars", "Aron Bow", "Harry Haynes")
yob2 = c(1981, 1983, 1981, 1982, 1983, 1980, 1980, 1986, 1982, 1978, 1977, 1981, 1979, 1975, 1980)
dataB = data.frame(name2, yob2)

Answer 1

根据评论编辑其他代码

也许这会对你有所帮助

你的数据

name1 = c("John Smith", "Adam Bower", "Felix von Epstein", "Charles Sawyer", "Benjamin Hoynes")
yob1 = c(1980, 1977, 1981, 1981, 1978)
dataA = data.frame(name1, yob1)

name2 = c("Jon Smyth", "Perry Bower", "Felix Epstein", "Terry Barnes", "John Smith", "Benamin Hoynes", "Frank Sawyer", "Charles Sawer", "Charles Sauer", "Philip Smith", "Franklin Sawyer", "Jonathan Smith", "Gabriel Bars", "Aron Bow", "Harry Haynes")
yob2 = c(1981, 1983, 1981, 1982, 1983, 1980, 1980, 1986, 1982, 1978, 1977, 1981, 1979, 1975, 1980)
dataB = data.frame(name2, yob2)

---

近似字符串匹配和年龄段过滤的功能

top_five_amatch <- function(A_row, B) {
                require(stringdist)
                ans <- intersect(order(stringdist(A_row$name1, dataB$name2, method="jw")), which(abs(A_row$yob1 - dataB$yob2) <= 5))
                return(head(ans, 5))
            }

其核心是

library(stringdist)
order(stringdist(dataA$name1[1], dataB$name2, method="jw"))     # order of string-distance
# [1]  5  1 12 10 14  7  8  9  6 11  3  2  4 15 13

which(abs(dataA$yob1[1] - dataB$yob2) <= 5)                     # age band filter
# [1]  1  2  3  4  5  6  7  9 10 11 12 13 14 15 

2的intersect将仅保留年龄段过滤后出现的值

---

主要 抓住每行dataA最接近匹配的索引

I <- lapply(seq_len(nrow(dataA)), function(i) top_five_amatch(dataA[i,], dataB))
# [[1]]
# [1]  5  1 12 10 14

# [[2]]
# [1] 14  7  1  4  6

# [[3]]
# [1]  3  1  2  6 11

# [[4]]
# [1]  8  9  7 11  2

# [[5]]
# [1]  6 15  4  2 11

每排dataA的前5名比赛

matchB <- dataB[unlist(I), ]
               # name2 yob2
# 5         John Smith 1983
# 1          Jon Smyth 1981
# 12    Jonathan Smith 1981
# 10      Philip Smith 1978
# 14          Aron Bow 1975
# 14.1        Aron Bow 1975
# 7       Frank Sawyer 1980
# 1.1        Jon Smyth 1981
# 4       Terry Barnes 1982
# 6     Benamin Hoynes 1980
# 3      Felix Epstein 1981
# 1.2        Jon Smyth 1981
# 2        Perry Bower 1983
# 6.1   Benamin Hoynes 1980
# 11   Franklin Sawyer 1977
# 8      Charles Sawer 1986
# 9      Charles Sauer 1982
# 7.1     Frank Sawyer 1980
# 11.1 Franklin Sawyer 1977
# 2.1      Perry Bower 1983
# 6.2   Benamin Hoynes 1980
# 15      Harry Haynes 1980
# 4.1     Terry Barnes 1982
# 2.2      Perry Bower 1983
# 11.2 Franklin Sawyer 1977

要以多列保存“宽”格式，请尝试类似的方法

matchB <- lapply(I, function(i) dataB[i,])
Reduce("cbind", matchB)
            # name2 yob2           name2 yob2           name2 yob2
# 5      John Smith 1983    Frank Sawyer 1980   Felix Epstein 1981
# 1       Jon Smyth 1981 Franklin Sawyer 1977  Benamin Hoynes 1980
# 12 Jonathan Smith 1981        Aron Bow 1975     Perry Bower 1983
# 10   Philip Smith 1978  Benamin Hoynes 1980    Terry Barnes 1982
# 14       Aron Bow 1975    Gabriel Bars 1979 Franklin Sawyer 1977
             # name2 yob2           name2 yob2
# 5    Charles Sawer 1986  Benamin Hoynes 1980
# 1    Charles Sauer 1982 Franklin Sawyer 1977
# 12 Franklin Sawyer 1977    Harry Haynes 1980
# 10    Frank Sawyer 1980    Terry Barnes 1982
# 14    Gabriel Bars 1979   Felix Epstein 1981