1

我有一个大约 8000 个字符串的向量。向量中的每个元素都是一个公司名称。

我的目标

我的目标是将这些公司名称聚类成组，以便每个集群包含一组彼此相似的公司名称（例如：ROYAL DUTCH SHELL、SHELL USA、BMCC SHELL 等......将属于同一个组/cluster，因为它们都是基于壳牌的公司，即它们的名称中包含“壳牌”一词）。

在处理这种大小的向量时，使用我采用的聚类技术查找相似公司名称的组似乎需要很长时间。然而，在较小的向量上，这种方法效果很好。

让我使用一个公司名称的示例向量来演示我的方法，该向量比原来的要小得多。

对于一个小的字符串向量，这种方法非常有效。

矢量看起来像这样

string=c("ROYAL DUTCH SHELL","Kremlin Prestige","Bateaux Mouches","Red Square Kremlin Inc","SHELL USA","KLM NEDERLAND","KLM GROUP","SHELL AUSTRALIA","BP TANGUH","LEROY MERLIN","SHELL AZERBAIJAN","BMCC SHELL",
     "GAS PLANT BERLIN","SHELL AQUA MARINA","AUCHAN LEROY","GROUPE ROYAL TANGUH","klm hostel","SHELL","TANGUH TOWN","KPMG")

我的尝试

为了解决这个问题，我使用了层次聚类方法。

# load packages
pacman::p_load(stringdist, dplyr, tm, gplots)

但是先做一些准备工作

#Function to clean strings
str_clean <- function(strings) {
 require(dplyr)
 require(tm)
 strings %>% tolower() %>% removePunctuation() %>% stripWhitespace() %>% 
 trim()
}

# Clean company names
clean_names = str_clean(string)

n = length(clean_names)

现在计算单词之间的距离，用于聚类

# Distance methods
methods <- c("lcs", "osa", "cosine")
q <- c(0, 0, 3)  #size of q-gram

dist.methods <- list()

# create distance matrix for every pair of listing, for each method
for (m in 1:length(methods)) {
dist = matrix(NA, ncol = n, nrow = n)  #initialize empty matrix
# row.names(dist) = prods
for (i in 1:n) {
for (j in 1:n) {
  dist[i, j] <- stringdist(clean_names[i], clean_names[j], method = methods[m], 
                           q = q[m])
}
}
 dist.methods[[m]] <- dist
 }

完成距离计算后，我选择一种方法并设置适当的截止值

#hierarchical clustering with cut-off of 0.2
clusters <- hclust(as.dist(dist.methods[[3]]))
plot(clusters)
df=as.data.frame(cbind("Companies" = clean_names, "Cluster" = cutree(clusters, h = .99)))

结果数据框将所有公司名称分类为集群，就像我想要的那样。

df=df %>% group_by(Cluster)

但是，就像我提到的，当我使用包含 8000 个公司名称的原始向量时，距离计算时间太长，我无法继续。

我的问题

当我使用更大的字符串向量时，这种方法是否有解决方法？

也许对于更大的向量，聚类不是解决这个问题的正确方法？在这种情况下，我还能做些什么来达到我的结果？

任何帮助将不胜感激。

4

1 回答 1

1

摆脱内部两个 for 循环，这会减慢你的速度，使用stringdistmatrix你的向量很长，但字符串很小，你会在底部看到基准。

library(stringdist)

strings <- c("ROYAL DUTCH SHELL","Kremlin Prestige","Bateaux Mouches","Red Square Kremlin Inc","SHELL USA","KLM NEDERLAND","KLM GROUP","SHELL AUSTRALIA","BP TANGUH","LEROY MERLIN","SHELL AZERBAIJAN","BMCC SHELL",
         "GAS PLANT BERLIN","SHELL AQUA MARINA","AUCHAN LEROY","GROUPE ROYAL TANGUH","klm hostel","SHELL","TANGUH TOWN","KPMG")
stringsBig <- rep(strings, 500)    
methods <- c("lcs", "osa", "cosine")
q <- c(0, 0, 3)  #size of q-gram    
dist.methods <- list()

# create distance matrix for every pair of listing, for each method
for (m in 1:length(methods)) {
  dist.methods[[m]] <- stringdistmatrix(stringsBig, method = methods[[m]], q = q[[m]])
}

microbenchmark::microbenchmark(stringdistmatrix(stringsBig),
                           for (i in 1:length(strings)) {
                             for (j in 1:length(strings)) {
                              stringdist(strings[i], strings[j])
                             }
                           },times = 100)

# Unit: microseconds
# expr                          min         lq       mean     median        uq       max neval cld
# stringdistmatrix(strings) 105.212   131.2805   241.9271   251.2235   279.634  2909.624   100  a 
# for loop                36147.878 38165.8480 40411.9772 39527.5500 42170.895 54151.457   100   b

microbenchmark::microbenchmark(stringdistmatrix(stringsBig), times=10)
# Unit: seconds
# expr    min       lq    mean   median       uq      max neval
# stringdistmatrix(stringsBig) 1.5324 1.585354 1.66592 1.655901 1.691157 1.825333    10
于 2018-02-26T19:32:49.200 回答