Fuzzy matching - John Smith demo

Data and concept from Tackling the John Smith Problem – deduplicating data via fuzzy matching in R.

library(tidyverse)

Registered S3 methods overwritten by 'dbplyr':
  method         from
  print.tbl_lazy     
  print.tbl_sql      
-- Attaching packages --------------------------------------------------------- tidyverse 1.3.0 --
v ggplot2 3.3.2     v purrr   0.3.4
v tibble  3.0.4     v dplyr   1.0.2
v tidyr   1.1.2     v stringr 1.4.0
v readr   1.4.0     v forcats 0.5.0
-- Conflicts ------------------------------------------------------------ tidyverse_conflicts() --
x dplyr::filter() masks stats::filter()
x dplyr::lag()    masks stats::lag()

library(readxl)
library(stringdist)

Attaching package: 㤼㸱stringdist㤼㸲

The following object is masked from 㤼㸱package:tidyr㤼㸲:

    extract

# Hide the dplyr .groups message
options(dplyr.summarise.inform = FALSE)

Load data

johns <- read_xlsx(path = 'data/many_john_smiths.xlsx')

print(johns)

Looks like a pretty dirty dataset; there appear to be only 2 distinct individuals, each with 5 duplicate records.

Distance matrices

The stringdistmatrix function computes pairwise distance matrices for each combination of strings in the vector. Distance is defined as the number of character transformations required to turn one string into the other. For example:

c('sun', 'son', 'done') %>%
  stringdistmatrix(useNames = TRUE)

     sun son
son    1    
done   3   2

• sun -> son is 1 (replace u with o)
• sun -> done is 3 (replace s with d, u with o, add e to end)
• son -> done is 2 (replace s with d, add e to end)
• done -> don’t would be … (exercise for the reader)
• don’t -> donut would be …

If \(d_{i,j}\) represents string distance for word pairs \(i\) and \(j\), and \(l_i\) the character length of string \(i\), we can define similarity score as:

\[ 1 - \frac{d_{i,j}}{\max(l_i,l_j)} \]

similarity_score <- function(str_input, useNames = TRUE) {
  # Input string lengths
  length_i <- str_length(str_input)
  # Find max(l_i, l_j)
  maxlen <- combn(length_i, m = 2, FUN = max)
  # Compute distance matrix
  dist_matrix <- str_input %>% stringdistmatrix(useNames = useNames)
  # Compute similarity score matrix
  sim_matrix <- 1 - (dist_matrix / maxlen) %>% as.matrix()
  # Set lower triangular and diagonal to 0
  sim_matrix[lower.tri(sim_matrix)] <- 0
  diag(sim_matrix) <- 0
  sim_matrix %>%
    return()
}

Create a new function returning the largest pairwise combination of values.

# Adapted from:
# https://stackoverflow.com/questions/32544566/find-the-largest-values-on-a-matrix-in-r
nlargest <- function(m, n) {
  res <- order(m, decreasing = TRUE)[seq_len(n)]
  pos <- arrayInd(res, dim(m), useNames = TRUE)
  list(values = m[res], position = pos)
}

And a function to print results:

print_nlargest <- function(sim_score, sim_list, n) {
  for (i in 1:n) {
    rec <- rownames(sim_score)[sim_list$position[i, 1]]
    sim_rec <- colnames(sim_score)[sim_list$position[i, 2]]
    cat("score: ", sim_list$values[i], "\n")
    cat("record 1: ", rec, "\n")
    cat ("record 2: ", sim_rec, "\n\n")
  }
}

Parsing data

To make this work, we need to choose fields to examine to generate the distance scores.

johns <- johns %>%
  mutate(
    concat = paste0(FirstName, LastName, AddressLine1, AddressPostcode, AddressSuburb, Phone)
    , printable = paste(Title, FirstName, LastName, AddressLine1, AddressPostcode, AddressSuburb, Phone)
  )

johns %>% select(printable) %>% print()

Now test each of my functions, defined in the previous step.

sim_score <- similarity_score(johns$concat)
similarity_score(johns$concat, useNames = FALSE) %>% round(3)

   1     2     3     4     5     6     7     8     9    10
1  0 0.837 0.756 0.643 0.561 0.463 0.524 0.762 0.548 0.605
2  0 0.000 0.698 0.512 0.419 0.512 0.465 0.698 0.488 0.488
3  0 0.000 0.000 0.429 0.359 0.300 0.381 0.595 0.548 0.419
4  0 0.000 0.000 0.000 0.643 0.714 0.786 0.524 0.500 0.698
5  0 0.000 0.000 0.000 0.000 0.575 0.500 0.476 0.452 0.488
6  0 0.000 0.000 0.000 0.000 0.000 0.667 0.405 0.310 0.558
7  0 0.000 0.000 0.000 0.000 0.000 0.000 0.476 0.452 0.628
8  0 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.476 0.488
9  0 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.442
10 0 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000

sim_list <- nlargest(sim_score, 5)
print(sim_list)

$values
[1] 0.8372093 0.7857143 0.7619048 0.7560976 0.7142857

$position
     row col
[1,]   1   2
[2,]   4   7
[3,]   1   8
[4,]   1   3
[5,]   4   6

Eyeballing the full matrix above, this all makes sense.

print_nlargest(sim_score, sim_list, n = 5)

score:  0.8372093 
record 1:  JohnSmith12 Acadia Rd9671Burnton1234 5678 
record 2:  JhonSmith12 Arcadia Road967Bernton1233 5678 

score:  0.7857143 
record 1:  JohnSmith13 Kynaston Rd9671Burnton34561234 
record 2:  JonSmith13 Kinaston Rd9761Barnston36451223 

score:  0.7619048 
record 1:  JohnSmith12 Acadia Rd9671Burnton1234 5678 
record 2:  JohnSmith12 Aracadia St9761Brenton12345666 

score:  0.7560976 
record 1:  JohnSmith12 Acadia Rd9671Burnton1234 5678 
record 2:  JSmith12 Acadia Ave867`1Burnton1233 567 

score:  0.7142857 
record 1:  JohnSmith13 Kynaston Rd9671Burnton34561234 
record 2:  JohnS12 Kinaston Road9677Bernton34561223 

The results look right to me.