匹配姓名相似的人：R

Question

我在R工作

我的数据有 500,000 行，但这里使用了一个小例子。

我有一些学校工作人员的数据。有些人在一所学校工作，有些人在两所学校工作，有些人在三所学校等。他们工作的每个学校都是一行数据。

学校并不总是记录每个人的相同名字。例如一所学校记录为威尔，另一所学校记录为威廉。

我也有这样的假设：对于在不止一所学校工作的个人，他们的名字和出生日期在每所学校总是记录相同。

基于名字的相似性，我想要一种方法来识别可能是同一个人的人，然后为他们分配一个id。

会有某种形式的中断，例如格雷格和格里芬很可能不是同一个人，即使他们的前两个字母相同。

样本数据：

data_current <- data.frame(first_name = c("will", "william", "william", "laura", "jessica", "jessicalouise", "james", "greg", "griffin"), 
                           last_name = c("smith", "smith", "smith", "maxwell", "maxwell", "maxwell", "lead", "jones", "jones"),
                           date_of_birth = c("2000-01-02","2000-01-02", "2000-01-02", "2007-01-02","2007-01-02","2007-01-02","1999-01-02","2004-01-02","2004-01-02"), 
                           school_id = c(1, 2, 3, 4, 5, 6, 7, 8, 9))

名字	第二名	出生日期	学校_id
将会	史密斯	2000-01-02	1
威廉	史密斯	2000-01-02	2
威廉	史密斯	2000-01-02	3
劳拉	麦克斯韦	2007-01-02	4
杰西卡	麦克斯韦	2007-01-02	5
杰西卡路易丝	麦克斯韦	2007-01-02	6
詹姆斯	领先	1999-01-02	7
格雷格	琼斯	2004-01-02	8
狮鹫	琼斯	2004-01-02	9

所需数据：

很可能前三个人是同一个人，所以分配了相同的person_id，以此类推...

data_desired <- data.frame(first_name = c("will", "william", "william", "laura", "jessica", "jessicalouise", "james", "greg", "griffin"), 
                           last_name = c("smith", "smith", "smith", "maxwell", "maxwell", "maxwell", "lead", "jones", "jones"),
                           date_of_birth = c("2000-01-02","2000-01-02", "2000-01-02", "2007-01-02","2007-01-02","2007-01-02","1999-01-02","2004-01-02","2004-01-02"), 
                           school_id = c(1, 2, 3, 4, 5, 6, 7, 8, 9),
                           person_id = c(1, 1, 1, 2, 3, 3, 4, 5, 6))

名字	第二名	出生日期	学校_id	person_id
将会	史密斯	2000-01-02	1	1
威廉	史密斯	2000-01-02	2	1
威廉	史密斯	2000-01-02	3	1
劳拉	麦克斯韦	2007-01-02	4	2
杰西卡	麦克斯韦	2007-01-02	5	3
杰西卡路易丝	麦克斯韦	2007-01-02	6	3
詹姆斯	领先	1999-01-02	7	4
格雷格	琼斯	2004-01-02	8	5
狮鹫	琼斯	2004-01-02	9	6

有人对如何解决这个问题有建议吗？

Answer 1

这是使用字符串相似性的一种可能性。它在您的示例中效果很好，因为您的数据完全分离。但是，超过 50K 行时您可能会遇到一些问题，但它可以帮助您入门：

library(stringdist)
library(dplyr)
library(purrr)

group_first <- function(dat, cutoff = 0.5) {
  M <- stringsimmatrix(dat$first_name, dat$first_name, method = "cosine", q = "2")
  l <- unique(lapply(seq_len(nrow(M)), \(x) dat$first_name[M[x, ] > cutoff]))
  
  person_id <- map(dat$first_name, ~ which(grepl(.x, l, fixed = T))) |>
    modify_if(~ length(.x) > 1, ~ 0)
  
  return(unlist(person_id))
}

data_current |>
  mutate(person_id = group_first(pick(everything())), .by = c(date_of_birth, last_name)) |>
  mutate(person_id = cur_group_id(), .by = c(date_of_birth, last_name, person_id))

输出

     first_name last_name date_of_birth school_id person_id
1          will     smith    2000-01-02         1         1
2       william     smith    2000-01-02         2         1
3       william     smith    2000-01-02         3         1
4         laura   maxwell    2007-01-02         4         2
5       jessica   maxwell    2007-01-02         5         3
6 jessicalouise   maxwell    2007-01-02         6         3
7         james      lead    1999-01-02         7         4
8          greg     jones    2004-01-02         8         5
9       griffin     jones    2004-01-02         9         6