Эффективный расчет всех расстояний между одной точкой и группой точек в R

Question

Прежде всего, я новичок в R (я начал вчера).

У меня есть две группы точек, data и centers, первая с размером n и втораяразмером K (например, n = 3823 и K = 10), и для каждого i в первом наборе мне нужно найти j во втором с минимальным расстоянием.

Моя идея проста: для каждого i, пусть dist[j] будет расстояние между i и j, мне нужно всего лишь использовать which.min(dist), чтобы найти то, что я ищу.

Каждыйточка - это массив 64 удваивается, поэтому

> dim(data)
[1] 3823   64
> dim(centers)
[1] 10 64

Я пробовал с

for (i in 1:n) {
  for (j in 1:K) {
    d[j] <- sqrt(sum((centers[j,] - data[i,])^2))
  }
  S[i] <- which.min(d)
}

, что очень медленно (с n = 200, это занимает более 40 с !!).Самое быстрое решение, которое я написал, это

distance <- function(point, group) {
  return(dist(t(array(c(point, t(group)), dim=c(ncol(group), 1+nrow(group)))))[1:nrow(group)])
}

for (i in 1:n) {
  d <- distance(data[i,], centers)
  which.min(d)
}

Даже если он делает много вычислений, которые я не использую (потому что dist(m) вычисляет расстояние между всеми строками m), это путьбыстрее, чем другой (кто-нибудь может объяснить, почему?), но он не достаточно быстр для того, что мне нужно, потому что он не будет использоваться только один раз.Кроме того, код distance очень уродлив.Я попытался заменить его на

distance <- function(point, group) {
  return (dist(rbind(point,group))[1:nrow(group)])
}

, но это, кажется, в два раза медленнее.Я также пытался использовать dist для каждой пары, но это также медленнее.

Я не знаю, что делать сейчас.Кажется, я делаю что-то очень неправильно.Любая идея о том, как сделать это более эффективно?

ps: мне нужно это, чтобы реализовать k-средства вручную (и мне нужно сделать это, это часть задания).Я считаю, что мне понадобится только евклидово расстояние, но я еще не уверен, поэтому я предпочту иметь некоторый код, в котором вычисление расстояния можно легко заменить.stats::kmeans сделать все вычисления менее чем за одну секунду.

Answer 1

Вместо того, чтобы выполнять итерации по точкам данных, вы можете просто сконвертировать это в матричную операцию, то есть вам придется выполнять итерацию по K.

# Generate some fake data.
n <- 3823
K <- 10
d <- 64
x <- matrix(rnorm(n * d), ncol = n)
centers <- matrix(rnorm(K * d), ncol = K)

system.time(
  dists <- apply(centers, 2, function(center) {
    colSums((x - center)^2)
})
)

Работает в:

utilisateur     système      écoulé 
      0.100       0.008       0.108 

на моем ноутбуке.

Answer 2

rdist () - это функция R из пакета {fields}, которая может быстро вычислять расстояния между двумя наборами точек в матричном формате.

https://www.image.ucar.edu/~nychka/Fields/Help/rdist.html

Использование:

library(fields)
#generating fake data
n <- 5
m <- 10
d <- 3

x <- matrix(rnorm(n * d), ncol = d)
y <- matrix(rnorm(m * d), ncol = d)

rdist(x, y)
          [,1]     [,2]      [,3]     [,4]     [,5]
 [1,] 1.512383 3.053084 3.1420322 4.942360 3.345619
 [2,] 3.531150 4.593120 1.9895867 4.212358 2.868283
 [3,] 1.925701 2.217248 2.4232672 4.529040 2.243467
 [4,] 2.751179 2.260113 2.2469334 3.674180 1.701388
 [5,] 3.303224 3.888610 0.5091929 4.563767 1.661411
 [6,] 3.188290 3.304657 3.6668867 3.599771 3.453358
 [7,] 2.891969 2.823296 1.6926825 4.845681 1.544732
 [8,] 2.987394 1.553104 2.8849988 4.683407 2.000689
 [9,] 3.199353 2.822421 1.5221291 4.414465 1.078257
[10,] 2.492993 2.994359 3.3573190 6.498129 3.337441

Answer 3

dist работает быстро, потому что не векторизован и вызывает внутренние функции C.
Ваш код в цикле может быть векторизован разными способами.

Например, для вычисления расстояния между data и centers вы можете использовать outer:

diff_ij <- function(i,j) sqrt(rowSums((data[i,]-centers[j,])^2))
X <- outer(seq_len(n), seq_len(K), diff_ij)

Это дает вам n x K матрицу расстояний.И должно быть намного быстрее, чем цикл.

Тогда вы можете использовать max.col, чтобы найти максимум в каждой строке (см. Справку, есть некоторые нюансы, когда много максимумов).X должно быть отрицательным, потому что мы ищем минимум.

CL <- max.col(-X)

Чтобы быть эффективными в R, вы должны по возможности векторизоваться.Петли во многих случаях могут быть заменены векторизованной заменой.Проверьте справку для rowSums (которые также описывают rowMeans, colSums, rowSums), pmax, cumsum.Вы можете найти SO, например, https://stackoverflow.com/search?q=[r]+avoid+loop (скопируйте и вставьте эту ссылку, я не знаю, как сделать ее кликабельной) для некоторых примеров.

Answer 4

Возможно, вы захотите взглянуть на функции apply.

Например, этот код

for (j in 1:K)
    {
    d[j] <- sqrt(sum((centers[j,] - data[i,])^2))
    }

может быть легко заменен на что-то вроде

dt <- data[i,]
d <- apply(centers, 1, function(x){ sqrt(sum(x-dt)^2)})

Вы можете определенно оптимизировать его больше, но вы поняли, я надеюсь

Answer 5

Мое решение:

# data is a matrix where each row is a point
# point is a vector of values
euc.dist <- function(data, point) {
  apply(data, 1, function (row) sqrt(sum((point - row) ^ 2)))
}

Вы можете попробовать это, как:

x <- matrix(rnorm(25), ncol=5)
euc.dist(x, x[1,])