R:生成与 stringdist 和 stringdistmatrix 相近匹配的列表

R: producing a list of near matches with stringdist and stringdistmatrix

我发现了优秀的软件包 "stringdist",现在想用它来计算字符串距离。特别是我有一组单词,我想打印出近似匹配,其中 "near match" 是通过某种算法(如 Levenshtein 距离)得到的。

我在 shell 脚本中的工作代码非常慢,我能够加载 stringdist 并生成一个带有度量的矩阵。现在我想将该矩阵归结为一个较小的矩阵,该矩阵仅具有接近的匹配项,例如其中指标非零但小于某个阈值。

kp <-  c('leaflet','leafletr','lego','levenshtein-distance','logo')
kpm <- stringdistmatrix(kp,useNames="strings",method="lv")
> kpm
                     leaflet leafletr lego levenshtein-distance
leafletr                   1                                   
lego                       5        6                          
levenshtein-distance      16       16   18                     
logo                       6        7    1                   19
m = as.matrix(kpm)
close = apply(m, 1, function(x) x>0 & x<5)
>  close
                     leaflet leafletr  lego levenshtein-distance  logo
 leaflet                FALSE     TRUE FALSE                FALSE FALSE
 leafletr                TRUE    FALSE FALSE                FALSE FALSE
 lego                   FALSE    FALSE FALSE                FALSE  TRUE
 levenshtein-distance   FALSE    FALSE FALSE                FALSE FALSE
 logo                   FALSE    FALSE  TRUE                FALSE FALSE

好的,现在我有一个(大)dist,我如何将它缩减回一个列表,输出类似于

leafletr,leaflet,1
logo,lego,1

仅适用于度量非零且小于 n=5 的情况?我找到了"apply()"可以让我做测试,现在我需要弄清楚如何使用它。

这个问题不是 stringdist 和 stringdistmatrix 特有的,而且是非常初级的 R,但我仍然被卡住了。我怀疑答案涉及 subset(),但我不知道如何将 "dist" 转换为其他内容。

设置您的数据:

library('stringdist')
library('dplyr')
kp <-  c('leaflet','leafletr','lego','levenshtein-distance','logo')
kpm <- stringdistmatrix(kp,useNames="strings",method="lv")

我们可以在此处将 kpm 更改为数据框:

kpm <- data.frame(as.matrix(kpm))

这是一种获取数据框的方法,该数据框具有“1”以标记单词足够接近的位置:

idx <- apply(kpm, 2, function(x) x >0 & x<5)
idx <- apply(idx, 1:2, function(x) if(isTRUE(x)) x<-1 else x<-NA)
#> idx
#                     leaflet leafletr lego levenshtein.distance logo
#  leaflet                   NA        1   NA                   NA   NA
#  leafletr                   1       NA   NA                   NA   NA
#  lego                      NA       NA   NA                   NA    1
#  levenshtein-distance      NA       NA   NA                   NA   NA
#  logo                      NA       NA    1                   NA   NA

为了让事情变得简单,融化数据框,过滤它并去掉最后一列:

final <- melt(idx) %>%
        filter(value==1) %>%
        select(Var1, Var2)

别忘了把所有东西都变回字符,而不是因子! (有时就像 R 中的破纪录...)

final[] <- lapply(final, as.character)
#> final
#      Var1     Var2
#  leafletr  leaflet
#   leaflet leafletr
#      logo     lego
#      lego     logo

现在我们去掉重复项:

final <- final[!duplicated(data.frame(list(do.call(pmin,final),do.call(pmax,final)))),]

加上一些好名字,你就可以开始了。

names(final) <- c('string 1', 'string 2')
#> final
# string 1 string 2
# leafletr  leaflet
#     logo     lego

(虽然你请求了一个列表,但这是一个数据框。从这里可以很容易地根据你的需要转换成你想要的任何东西,例如,写入 csv 等)

你可以这样做:

library(reshape2)
d <- unique(melt(m))
out <- subset(d, value > 0 & value < 5)

此处,meltm 转换为长格式(2 列包含字符串名称,1 列包含值)。然而,由于我们已经融化了一个对称矩阵,我们使用 unique 来表示 de-duplication。

另一种方法是使用 dplyr(因为现在所有酷孩子都在使用带有管道的 dplyr):

library(dlpyr)
library(reshape2)
library(magrittr)

out <- melt(m) %>% distinct() %>% filter(value > 0 & value < 5)

第二个选项可能更快,但我还没有真正计时。