r - 基于自定义距离函数优化R代码创建距离矩阵

Question

我正在尝试为基于自定义距离函数的字符串创建一个距离矩阵(用于聚类)。我在一个 6000 字的列表上运行了代码，它自过去 90 分钟以来仍在运行。我有 8 GB RAM 和 Intel-i5，所以问题仅在于代码。
这是我的代码:

library(stringdist)
#Calculate distance between two monograms/bigrams
stringdist2 <- function(word1, word2)
{
    #for bigrams - phrases with two words
    if (grepl(" ",word1)==TRUE) {
        #"Hello World" and "World Hello" are not so different for me
        d=min(stringdist(word1, word2),
        stringdist(word1, gsub(word2, 
                          pattern = "(.*) (.*)", 
                          repl="\\2,\\1")))
    }
    #for monograms(words)
    else{
        #add penalty of 5 points if first character is not same
        #brave and crave are more different than brave and bravery
        d=ifelse(substr(word1,1,1)==substr(word2,1,1),
                            stringdist(word1,word2),
                            stringdist(word1,word2)+5)
    }   
    d
}
#create distance matrix
stringdistmat2 = function(arr)
{
    mat = matrix(nrow = length(arr), ncol= length(arr))
    for (k in 1:(length(arr)-1))
    {
        for (j in k:(length(arr)-1))
        {           
            mat[j+1,k]  = stringdist2(arr[k],arr[j+1])      
        }
    }
    as.dist(mat)    
}

test = c("Hello World","World Hello", "Hello Word", "Cello Word")
mydmat = stringdistmat2(test)
> mydmat
  1 2 3
2 1    
3 1 2  
4 2 3 1

我认为问题可能是我使用循环而不是应用 - 但后来我发现在很多地方循环并不是那么低效。更重要的是，我不够熟练，无法将应用程序用于我的循环，嵌套循环就像 k in 1:n和 j in k:n .我想知道是否还有其他可以优化的东西。

Answer 1

有趣的问题。所以一步一步来:

1 - stringdist函数已经向量化:

#> stringdist("byye", c('bzyte','byte'))
#[1] 2 1

#> stringdist(c('doggy','gadgy'), 'dodgy')
#[1] 1 2

但是给出两个长度相同的向量， stringdist将导致在每个向量上并行循环(不会产生具有交叉结果的矩阵)，如 Map会做:

#> stringdist(c("byye","alllla"), c('bzyte','byte'))
#[1] 2 6

2 - 重写您的函数，以便您的新函数 保留此矢量化特征 :

stringdistFast <- function(word1, word2)
{
    d1 = stringdist(word1, word2)
    d2 = stringdist(word1, gsub("(.+) (.+)", "\\2 \\1", word2))

    ifelse(d1==d2,d1+5*(substr(d1,1,1)!=substr(d2,1,1)),pmin(d1,d2))
}

它确实以相同的方式工作:

#> stringdistFast("byye", c('bzyte','byte'))
#[1] 2 1

#> stringdistFast("by ye", c('bzyte','byte','ye by'))
#[1] 3 2 0

3 - 仅使用一个循环且仅在三角形部分重写 dismatrix 函数(没有 outer，它很慢!):

stringdistmatFast <- function(test)
{
    m = diag(0, length(test))
    sapply(1:(length(test)-1), function(i)
    {
        m[,i] <<- c(rep(0,i), stringdistFast(test[i],test[(i+1):length(test)]))
    }) 

    `dimnames<-`(m + t(m), list(test,test))
}

4 - 使用函数:

#> stringdistmatFast(test)
#            Hello World World Hello Hello Word Cello Word
#Hello World           0           0          1          2
#World Hello           0           0          1          2
#Hello Word            1           1          0          1
#Cello Word            2           2          1          0