Question

如何对R中的单词（非字符）级别进行Levenshtein距离测量？

请参阅以下内容：

预期结果1）

# levenshtein operations needed: Delete*2 --> 2 operations
array1 <- c("word", "car")
array2 <- c("word", "pool", "beer", "car")

我正在寻找一个函数levenshtein()，因此上面的例子返回了2的距离：

levenshtein(array1, array2)
--> 2

预期结果2）

# levenshtein operations needed: Delete and insert --> 2 operations
array1 <- c("word", "car", "pool")
array2 <- c("word", "pool", "car")

我正在寻找一个函数levenshtein()，因此上面的例子返回了2的距离：

levenshtein(array1, array2)
--> 2

我发现了以下内容： Word-level edit distance of a sentence 但我没有找到一个能够产生预期结果的有效的needleman-wunsch实现，如上所述。

Answer 1

不完全确定你在问什么...但这就是你所追求的目标吗？

lapply(array1, function(i){
    m <- drop(attr(adist(i, array2, counts = TRUE), "counts")) 
    row.names(m) <- array2
    setNames(list(m %>% as.data.frame()), i)
}) %>% unlist(recursive = FALSE)
$word
     ins del sub
word   0   0   0
pool   0   0   3
beer   1   1   2
car    0   1   2

$car
     ins del sub
word   1   0   2
pool   1   0   3
beer   1   0   2
car    0   0   0

Answer 2

我们可以将唯一字词映射到letters，并使用adist作为广义编辑距离的引擎。

levenshtein <- function(x, y){
  unique_words <- unique(c(x,y))
  letter_x <- plyr::mapvalues(x,
                              from = unique_words,
                              to = letters[1:length(unique_words)])
  letter_y <- plyr::mapvalues(y,
                              from = unique_words,
                              to = letters[1:length(unique_words)])
  adist(paste0(letter_x,collapse=''),paste0(letter_y,collapse=''))
}

array1 <- c("word", "car")
array2 <- c("word", "pool", "beer", "car")

levenshtein(array1, array2)


array1 <- c("word", "car", "pool")
array2 <- c("word", "pool", "car")

levenshtein(array1, array2)

显然，此函数只能用于两个小于或等于26个唯一字的字符向量，您可以将其推广为52（添加大写Letters）或62（数字）等。 ..

更好的方法显然是重写adist函数......

Levenshtein在R句子中的距离

2 个答案: