Запуск Левенштейна занимает больше времени в R

Question

Я хочу применить левенштейн к 2 столбцам - s1 $ Response и s2 $ Response, позже мне нужно отфильтровать их по <0,4 и связать их как Var1 и Var2. Следующий код, когда я запускаю, отнимает слишком много времени, так как выполняется много записей (это занимает несколько часов). Пожалуйста, помогите мне сделать это быстрее, предоставив любую альтернативу. </p>

 kk=cross2(.x = s2$Response, .y = s1$Response, .filter = ~levenshteinSim(.x, .y) < 0.4) %>% map(set_names, c("var1", "var2")) %>% bind_rows()

Answer 1

Если ваш код выполняется levenshteinSim как вызов функции каждый раз для каждой комбинации s1 и s2, это будет мучительно медленным.Может быть, сначала составить список всех комбинаций s1 / s2, а затем запустить levenshteinSim один раз в векторизованном виде?Это должно быть на порядки быстрее:

library(dplyr); library(purrr); library(RecordLinkage)

s1 <- rep(c("paul","patty","harris"), 80)
s2 <- rep(c("darren", "natty", "haris", "paulie"), 80)

system.time({
  egs <- expand.grid(s1, s2, stringsAsFactors=FALSE)
  lv  <- do.call(levenshteinSim, unname(egs))
  egs <- egs[!(lv > 0.6),]
})
#   user  system elapsed 
#   0.11    0.00    0.1

system.time({
  cross2(.x = s1, .y = s2, .filter = ~levenshteinSim(.x, .y) > 0.6)
})
#   user  system elapsed 
#   2.98    0.00    2.97

Answer 2

Редактировать: Исходный ответ предполагал, что оба строковых вектора были одинаковой длины при создании таблицы.

Вот подход, который сравнивает два вектора из 1000 строк (1M комбинаций).Как долго вы работаете со столбцами?Если намного дольше и при условии, что вам нужно сравнить каждый элемент каждого элемента с каждым другим, это требует другого подхода.

library(tidyverse); library(stringdist)
set.seed(42)
Response1 = stringi::stri_rand_strings(1000, 6)
Response2 = stringi::stri_rand_strings(1000, 6)

# EDIT, should work for different length vectors
combos <- expand.grid(Response1, Response2, stringsAsFactors = F) %>%
    as_tibble() %>%

  # Here, levenshtein distance based on the average length of the two strings
  mutate(distance = stringdist(Var1, Var2, method = "lv") / 
           (nchar(Var1) + nchar(Var2) / 2)) %>%
  filter(distance < 0.4)