Нахождение, какие элементы в векторе имеют расстояние редактирования одинаковой длины?

Question

У меня есть датафрейм, ниже показан пример в формате .csv, в котором есть список слов (Word), количество звуков в этих словах (NumSounds) и транскрипция звуков в каждом слове (произношение). ). Я пытался создать файл, который показывает мне, каковы минимальные пары для каждого слова в списке. Это означает, что для каждого слова мне нужно знать, какие другие слова в списке имеют расстояние редактирования 1 от этого слова, а также имеют одинаковое количество звуков. Я делал это как R. l oop, который написал мой напарник, показан ниже:

library(stringdist)
words = vector(mode="character", length=nrow(df))
pairs = vector(mode="character", length=nrow(df))

pb = txtProgressBar(min=0, max=nrow(df), style=3)
for(i in 1:nrow(df)) {
  word = df$Pronunciation[i]
  nphones = df$NumSounds[i]
  potential_minimal_pairs = as.list(df$Pronunciation[df$Word != word & df$NumSounds == nphones])
  distances = stringdist(word, potential_minimal_pairs, method="lv")
  minimal_pairs = potential_minimal_pairs[distances == 1]
  word = unique(df$Word[datf$Pronunciation == word])[1]
  words = append(words, word)
  words[i] = word
  minimal_pairs = sapply(pairs, function(x) unique(df$Word[datf$Pronunciation == x])[1])
  pairs[i] = paste(minimal_pairs, ", ")
  setTxtProgressBar(pb, i)
}

myminimalpairs = data.frame(word=words, pairs=pairs)
head(myminimalpairs, 10)

Word,NumSounds,Pronunciation
abbey,3,&bi
abide,4,^b#d
abort,5,^b>rt
abroad,5,^br>d
abrupt,6,^br^pt
absence,6,&bs^ns
absent,6,&bs^nt
absorb,6,^bz>rb
absorbed,7,^bz>rbd
abstract,8,&bstr&kt
abused,6,^byuzd
abyss,4,^bIs
accents,7,&ksEnts
accepts,7,&ksEpts
accessed,6,&ksEst
accord,5,^k>rd
accuse,5,^kyuz
achieve,4,^Civ
achieved,5,^Civd
aching,4,ekIN

Answer 1

Один из вариантов - использовать stringdistmatrix() для создания матрицы расстояний, равных единице, и outer() для создания второй матрицы равных чисел. Индексы массива могут затем использоваться для возврата пар слов, которые соответствуют критериям (используя только нижний треугольник, чтобы избежать дублирования).

library(stringdist)

m1 <- as.matrix(stringdistmatrix(df$Word, method = "lv", useNames = TRUE)) == 1
m2 <- outer(df$NumSounds, df$NumSounds, `==`)
idx <- which(m1 & m2 & lower.tri(m1), arr.ind = TRUE)
data.frame(word1 = df$Word[idx[,1]], word2 = df$Word[idx[,2]], stringsAsFactors = FALSE)

    word1   word2
1 accepts accents