加速循环计算R中的Jaro-Winkler距离

Question

我在不止一个意义上是新来的。在我第一次尝试熟悉任何编程语言时，关于我的第一个脚本的第一篇文章。鉴于此，您可能会发现这个项目过于雄心勃勃，但是，嘿，边做边学一直是要走的路。我正在尽我所能在这里满足stackoverflow-etiquette，但如果我违反了任何规定，请告诉我。

我想编写一段代码，它可以应用某种模糊逻辑来匹配非结构化公司名称表（例如 Google）与结构化公司名称表（例如 Google Inc.）和丹麦公司标识符（@ 987654323@)。

我可以通过谷歌搜索找到一些代码，并且我设法操纵它们来处理我的项目。我发现 stringdist 包中包含的 Jaro-Winkler 算法特别适用于公司名称。当尝试将 40 个非结构化公司名称与数百个结构化名称进行比较和匹配时，该脚本工作得非常好，但我需要将大约 4000 个非结构化名称与包含 700k 个结构化名称的表进行比较和匹配。正如您可能已经猜到的那样，这需要很长时间。为了给您一个想法，我尝试将 6 个非结构化名称与 700k 匹配，这需要三个小时。快速计算告诉我，如果这是脚本的平均速度，我将需要将近 3 个月的时间来处理 4000 家公司，这有点让人不知所措。我知道它必须进行数十亿次计算，而这不可能在几分钟内完成。但是，如果我能将这种情况减少到可能只有几天，我会非常高兴，而且我觉得这一定是可能的。

所以，我正在寻找加速这段代码的方法。通过最初将精确匹配与match() 函数配对，我已经设法对其进行了一些改进，这使得大约 500 家公司需要使用模糊匹配算法进行进一步处理。不过，至少可以说这需要很长时间。

我希望我能够清楚地解释自己！任何建议都将受到高度赞赏。

library(stringdist)

#Reading the two files to be compared and making sure that I'm dealing with characters
companies.unstructured <- read.csv(
  "https://www.dropbox.com/s/opbk0s2q14l5c71/unstructured_companies.csv?dl=0", 
  sep = ";", 
  stringsAsFactors = FALSE
)
companies.structured <- read.csv(
  "https://www.dropbox.com/s/kyi0rvz77frr7sd/structured_companies_w_CVR.csv?dl=0", 
  sep=";", 
  stringsAsFactors = FALSE
)

#Using the match function to match up all 100% identical companies to avoid unnecessary workload for the Jaro-Winkler loop
companies.unstructured$CVR = companies.structured$CVR[match(companies.unstructured$Company, 
                                                            companies.structured$Company)]
companies.exact.match <- companies.unstructured[!is.na(companies.unstructured$CVR), ]

#Creating a subset to work on with the Jaro-Winkler loop.
companies.unstructured.na <- subset(companies.unstructured, is.na(CVR))

#And here's the loop measuring the distance between the company names using the Jaro-Winkler algorithm.
distance.methods<- c('jw')
dist.methods<-list()
for(m in 1:length(distance.methods))
{
  dist.name.enh<-matrix(NA, ncol = length(companies.structured$Company),
                        nrow = length(companies.unstructured.na$Company))
  for(i in 1:length(companies.structured$Company)) {
    for(j in 1:length(companies.unstructured.na$Company)) { 
      dist.name.enh[j,i]<-stringdist(tolower(companies.structured[i,]$Company),
                                     tolower(companies.unstructured.na[j,]$Company),
                                     method = distance.methods[m])      
    }  
  }
  dist.methods[[distance.methods[m]]]<-dist.name.enh
}

#matching up pairs of minimum distance
match.s1.s2.enh<-NULL
for(m in 1:length(dist.methods))
{

  dist.matrix<-as.matrix(dist.methods[[distance.methods[m]]])
  min.name.enh<-apply(dist.matrix, 1, base::min)
  for(i in 1:nrow(dist.matrix))
  {
    s2.i<-match(min.name.enh[i],dist.matrix[i,])
    s1.i<-i
    match.s1.s2.enh<-rbind(data.frame(s2.i=s2.i,
                                      s1.i=s1.i,
                                      s1Company=companies.unstructured.na[s1.i,]$Company,
                                      s2Company=companies.structured[s2.i,]$Company,
                                      CVR=companies.structured[s2.i,]$CVR,
                                      adist=min.name.enh[i],
                                      method=distance.methods[m]),
                           match.s1.s2.enh)
  }
}

编辑：以下是一些可以使用的数据示例：structured_companies_w_CVR 和 unstructured_companies

Answer 1

我分析了您的代码并发现了一些加速。我尽可能地遵守您的命名约定，以便您可以匹配差异。出于测试目的，我将文件保存在工作目录中。

1. 根据您需要的列和您需要的记录创建了一个空数据框。在循环中，您更新记录而不是使用 cbind。这大大加快了代码速度。我一直得到一个 0 的 system.time。因为 R 不知道数据帧的大小，所以它会使用 rbind 进行不断的复制，并且如果你有很多行，它往往会减慢这个过程。另请参阅post。即使数据框比您需要的大，更新记录的速度也会快得多。

   编辑：我设法从循环中删除了除了 match 函数之外的所有内容，数据帧的其余部分可以使用来自其他可用数据部分的向量/输入来完成。

2. 我在代码中添加了一个并行选项并使用了 stringdistmatrix。如果可用，此函数将并行运行，但您也不需要任何循环来计算距离。

代码部分：

library(stringdist)
library(parallel)


#Reading the two files to be compared and making sure that I'm dealing with characters
companies.unstructured <- read.csv("unstructured_companies.csv", 
                                   sep = ";", 
                                   stringsAsFactors = FALSE)
companies.structured <- read.csv("structured_companies_w_CVR.csv", 
                                 sep=";",
                                 stringsAsFactors = FALSE)

#Using the match function to match up all 100% identical companies to avoid unnecessary workload for the Jaro-Winkler loop
companies.unstructured$CVR <- companies.structured$CVR[match(companies.unstructured$Company, 
                                                             companies.structured$Company)]
companies.exact.match <- companies.unstructured[!is.na(companies.unstructured$CVR), ]

#Creating a subset to work on with the Jaro-Winkler loop.
companies.unstructured.na <- subset(companies.unstructured, is.na(CVR))

distance.method <- "jw"

# Parallel section starts here
# set number of cores to use. 
cores = 3
# initialize cluster
cl = makeCluster(cores, type = "SOCK")


# create distance matrix, shortest column will be recycled. 
# See stringdistmatrix documentation
dist.name.enh <- stringdistmatrix(tolower(companies.structured$Company),
                                  tolower(companies.unstructured.na$Company),
                                  method = distance.method,
                                  nthread = getOption("sd_num_thread"))

# get the minimun jaro distances from the matrix
min.name.enh <- parApply(cl, dist.name.enh, 2, base::min)

# stop the cluster
stopCluster(cl)
# Parallel section ends here

# create dataframe prefilled with empty values.
match.s1.s2.enh2 <- data.frame(s2.i = rep(NA, nrow(companies.unstructured.na)),
                               s1.i = rep(NA, nrow(companies.unstructured.na)),
                               s1Company = rep(NA, nrow(companies.unstructured.na)),
                               s2Company = rep(NA, nrow(companies.unstructured.na)),
                               CVR = rep(NA, nrow(companies.unstructured.na)),
                               adist = rep(NA, nrow(companies.unstructured.na)),
                               method = rep(NA, nrow(companies.unstructured.na)))

# fill s2.i with NA values for the length needed in the for loop
s2.i <- rep(NA, ncol(dist.name.enh))

# matching up pairs of minimum distance.
for(i in 1:ncol(dist.name.enh)) {
  s2.i[i]<-match(min.name.enh[i],dist.name.enh[,i])
}

match.s1.s2.enh2$s2.i <- s2.i
match.s1.s2.enh2$s1.i <- 1:ncol(dist.name.enh)
match.s1.s2.enh2$s1Company <- companies.unstructured.na$Company
match.s1.s2.enh2$adist <- min.name.enh
match.s1.s2.enh2$method <- distance.method
match.s1.s2.enh2$s2Company <- companies.structured$Company[s2.i] 
match.s1.s2.enh2$CVR <- companies.structured$CVR[s2.i]