(Speed ​​Challenge) Есть ли более быстрый способ вычислить матрицу расстояний в единицах c расстояния Хэмминга? - PullRequest
2 голосов
/ 09 января 2020

Я ищу более эффективный способ получить матрицу расстояний в терминах Расстояние Хэмминга .

Фоны

Я знаю там это функция hamming.distance() из пакета e1071 для вычисления матрицы расстояний, но я подозреваю, что она может быть очень медленной при использовании большой матрицы с большим количеством строк, поскольку она применяет вложенные циклы for для вычисления.

Пока у меня есть более быстрый способ (см. methodB) в коде ниже. Однако он подходит только для двоичного домена, т. Е. {0,1}^n. Однако он недоступен при обнаружении доменов, состоящих из более чем 2 элементов, т. Е. {0,1,2,...,K-1}^n. В этом смысле methodB не для обычного c расстояния Хэмминга.

Цель

Моя цель - найти подход, имеющий следующие особенности:

  • , составленный только из функций из базы R (без использования Rcpp переписать функцию для ускорения)
  • быстрее, чем мой подход methodB() для особого случая k=2
  • можно обобщить для любого натурального числа k
  • опережают по скорости hamming.distance() из пакета e1071

Мой код

library(e1071)
# vector length, i.e., number of matrix
n <- 7
# number of elements to consist of domain {0,1,...,k-1}^n
k <- 2
# matrix for computing hamming distances by rows
m <- as.matrix(do.call(expand.grid,replicate(n,list(0:k-1))))

# applying `hamming.distance()` from package "e1071", which is generic so it is available for any positive integer `k`
methodA <- function(M) hamming.distance(M)
# my customized method from base R function `dist()`, which is not available for cases `k >= 2`
methodB <- function(M) as.matrix(round(dist(M,upper = T,diag = T)**2))

и тест дает

microbenchmark::microbenchmark(
  methodA(m),
  methodB(m),
  unit = "relative",
  check = "equivalent",
  times = 50
)

Unit: relative
       expr      min       lq   mean   median       uq      max neval
 methodA(m) 33.45844 33.81716 33.963 34.30313 34.92493 14.92111    50
 methodB(m)  1.00000  1.00000  1.000  1.00000  1.00000  1.00000    50

Заранее признателен!

Ответы [ 2 ]

2 голосов
/ 09 января 2020
methodM <- function(x) {
  xt <- t(x)
  sapply(1:nrow(x), function(y) colSums(xt != xt[, y]))
}
microbenchmark::microbenchmark(
  methodB(m), methodM(m),
  unit = "relative", check = "equivalent", times = 50
)
# Unit: relative
#       expr  min       lq     mean   median       uq      max neval cld
# methodB(m) 1.00 1.000000 1.000000 1.000000 1.000000 1.000000    50  a 
# methodM(m) 1.25 1.224827 1.359573 1.219507 1.292463 4.550159    50   b
0 голосов
/ 05 февраля 2020

Вы пробовали использовать Rcpp? У меня была очень похожая проблема! Пожалуйста, смотрите ответ здесь: { ссылка }

...