r - 通过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$ 与数据 B 中的观察值的五个“最佳”匹配应该是 obs 编号 1、4、5、6，对于 +-5 年的出生年份限制。在这种情况下没有。 2 (Sara Pinkert) 由于名字不应该匹配，没有。 3 (John Smyth) 不应该匹配，因为这个观察的出生年份太晚了。

其他库提供的函数和命令，如 fastLink、stringdist 或 recordLinkage 既好又快，但它们总是只产生一个 -一对一匹配(他们很少有能力结合出生年份段的信息来限制匹配问题的维度)。

到目前为止，我已经能够弄清楚的关闭解决方案是使用 recordLinkage 中的 compare.linkage 函数，但阻止选项 (blockfld) 似乎严格阻止一个特定的变量，因此如何使用出生年份信息的范围并不明显:

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

但这只会阻止完美的生日，因此它会返回两个匹配项，这将是 obs no。 5 和 6(John Smith 1984，Jon Smith 1984)。

这是匹配问题的一些示例数据。由于体积小，它看起来微不足道，但在每个样本有 50 万个 obs 的整个样本中(其中一些出现在一个数据中但没有出现在其他数据中，一些出现在两个数据中但可能在他们的名字中有拼写错误)它更加棘手。

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