R：将相似的地址分组在一起

问题描述

我有一个40万行文件，其中包含手动输入的地址，这些地址需要进行地址编码。文件中相同地址的变化很多，因此多次对同一地址使用API调用似乎很浪费。

为减少这一点，我想减少以下五行：

    Address
    1 Main Street,Country A,World
    1 Main St,World
    1 Maine St,World
    2 Side Street,World
    2 Side St. Country A,World

下降到两个：

    Address
    1 Main Street,World

使用stringdist包，您可以将字符串的“单词”部分分组在一起，但是字符串匹配算法不能区分数字。这意味着它将同一条街道上的两个不同的门牌号归为同一地址。

要解决此问题，我想出了两种方法：首先，尝试使用正则表达式将数字和地址手动分离到单独的列中，然后再将它们重新加入。问题在于，手动输入的地址如此之多，似乎有数百种不同的边缘情况，而且变得笨拙。

使用grouping上的这个答案和converting个单词到数字的答案，我有第二种方法来处理边缘情况，但计算量却非常昂贵。有没有更好的第三种方法？

library(gsubfn)
library(english)
library(qdap)
library(stringdist)
library(tidyverse)


similarGroups <- function(x,thresh = 0.8,method = "lv"){
  grp <- integer(length(x))
  Address <- x
  x <- tolower(x)
  for(i in seq_along(Address)){
    if(!is.na(Address[i])){
      sim <- stringdist::stringsim(x[i],x,method = method)
      k <- which(sim > thresh & !is.na(Address))
      grp[k] <- i
      is.na(Address) <- k
    }
  }
  grp
}

df <- data.frame(Address = c("1 Main Street,World","1 Main St,"1 Maine St,"2 Side Street,"2 Side St. Country A,World"))

df1 <- df %>%
  # Converts Numbers into Letters
  mutate(Address = replace_number(Address),# Groups Similar Addresses Together
         Address = Address[similarGroups(Address,method = "lv")],# Converts Letters back into Numbers
         Address = gsubfn("\\w+",setNames(as.list(1:1000),as.english(1:1000)),Address)
  ) %>%
  # Removes the Duplicates
  unique()

解决方法

stringdist::stringsimmatrix允许比较字符串之间的相似性：

library(dplyr)
library(stringr)
df <- data.frame(Address = c("1 Main Street,Country A,World","1 Main St,"3 Main St,"2 Side Street,"2 Side St. PO 5678 Country A,World"))
                             
stringdist::stringsimmatrix(df$Address)
          1         2         3         4         5
1 1.0000000 0.8709677 0.8387097 0.8387097 0.5161290
2 0.8518519 1.0000000 0.9629630 0.6666667 0.4444444
3 0.8148148 0.9629630 1.0000000 0.6666667 0.4444444
4 0.8387097 0.7096774 0.7096774 1.0000000 0.6774194
5 0.5833333 0.5833333 0.5833333 0.7222222 1.0000000

正如您所指出的，在上面的示例中，根据此标准，第2行和第3行非常相似（96％），而门牌号却不同。

您可以添加另一个条件，从字符串中提取数字并比较它们的相似性：

# Extract numbers
nums <- df %>% rowwise %>% mutate(numlist = str_extract_all(Address,"\\(?[0-9]+\\)?"))  

# Create numbers vectors pairs
numpairs <- expand.grid(nums$numlist,nums$numlist)

# Calculate similarity
numsim <- numpairs %>% rowwise %>% mutate(dist = length(intersect(Var1,Var2)) / length(union(Var1,Var2)))

# Return similarity matrix
matrix(numsim$dist,nrow(df))

     [,1] [,2] [,3] [,4] [,5]
[1,]    1    1    0  0.0  0.0
[2,]    1    1    0  0.0  0.0
[3,]    0    0    1  0.0  0.0
[4,]    0    0    0  1.0  0.5
[5,]    0    0    0  0.5  1.0

根据此新标准，第2行和第3行明显不同。

您可以结合使用这两个条件来确定地址是否足够相似，例如：

matrix(numsim$dist,nrow(df)) * stringdist::stringsimmatrix(df$Address)

          1         2 3         4         5
1 1.0000000 0.8709677 0 0.0000000 0.0000000
2 0.8518519 1.0000000 0 0.0000000 0.0000000
3 0.0000000 0.0000000 1 0.0000000 0.0000000
4 0.0000000 0.0000000 0 1.0000000 0.3387097
5 0.0000000 0.0000000 0 0.3611111 1.0000000

要处理数十万个地址，expand.grid不适用于整个数据集，但是您可以按国家/地区来拆分/并行化，以避免产生不可行的完整笛卡尔积。

可能想研究OpenRefine或R的refinr包，虽然视觉效果不佳，但仍然不错。它具有两个功能，key_collision_merge和n_gram_merge，其中有几个参数。如果您有一个很好的地址字典，可以将其传递给key_collision_merge。

最好记下您经常看到的缩写（St.，Blvd.，Rd。等），并替换所有缩写。当然，这些缩写的某个地方有一张不错的桌子，例如https://www.pb.com/docs/US/pdf/SIS/Mail-Services/USPS-Suffix-Abbreviations.pdf。

然后：

library(refinr)    
df <- tibble(Address = c("1 Main Street,"1 Maine St,"2 Side St. Country A,"3 Side Rd. Country A,"3 Side Road Country B World"))
df2 <- df %>%
  mutate(address_fix = str_replace_all(Address,"St\\.|St\\,|St\\s","Street"),address_fix = str_replace_all(address_fix,"Rd\\.|Rd\\,|Rd\\s","Road")) %>%
  mutate(address_merge = n_gram_merge(address_fix,numgram = 1))

df2$address_merge
[1] "1 Main Street Country A,World"
[2] "1 Main Street Country A,World"
[3] "1 Main Street Country A,World"
[4] "2 Side Street Country A,World"
[5] "2 Side Street Country A,World"
[6] "3 Side Road Country A,World"  
[7] "3 Side Road Country B World"

qdap r r stringdist tidyverse