Le calcul de toutes les distances entre un point et un groupe de points efficacement dans la R

Tout d'abord, je suis nouveau sur R (j'ai commencé hier).

J'ai deux groupes de points, data et centers, la première de taille n et le second, de taille K (par exemple, n = 3823 et K = 10), et pour chaque i dans le premier set, j'ai besoin de trouver j dans la seconde, avec le minimum de distance.

Mon idée est simple: pour chaque i, laissez dist[j] la distance entre i et j, j'ai seulement besoin d'utiliser which.min(dist) à trouver ce que je cherche.

Chaque point est un tableau de 64 doubles, de sorte

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

J'ai essayé avec

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

qui est extrêmement lent (avec n = 200, il faut plus de 40 ans!!). La solution la plus rapide que j'ai écrit est

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)
}

Même si il fait beaucoup de calcul que je ne l'utilise pas (parce que dist(m) calcule la distance entre toutes les lignes de m), c'est plus rapide que l'autre (quelqu'un peut-il expliquer pourquoi?), mais il n'est pas assez rapide pour ce dont j'ai besoin, car il ne peut être utilisé qu'une seule fois. Et aussi, le distance code est très laid. J'ai essayé de le remplacer par

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

mais ce qui semble être deux fois plus lentement. J'ai aussi essayé d'utiliser dist pour chaque paire, mais il est aussi plus lent.

Je ne sais pas quoi faire maintenant. Il me semble que je suis en train de faire quelque chose de très mal. Aucune idée sur comment faire cela de manière plus efficace?

ps: j'en ai besoin pour mettre en œuvre des k-means à la main (et j'ai besoin de le faire, c'est le cadre d'une cession). Je crois que je vais seulement besoin de distance Euclidienne, mais je ne suis pas encore certain, donc je préfère avoir un peu de code où la distance de calcul peut être remplacé facilement. stats::kmeans faire tout le calcul en moins d'une seconde.

Les gens ici genre-une-ne-ressemble-à faire des travaux... donc essayez de vous concentrer sur un problème spécifique.

OriginalL'auteur dbarbosa | 2010-06-12

  1. 13

    Plutôt que d'une itération à travers les points de données, vous pouvez condenser que pour un fonctionnement de la matrice, ce qui signifie que vous n'avez qu'à itérer à travers 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)
})
)

    S'exécute dans:

    utilisateur     système      écoulé 
      0.100       0.008       0.108

    sur mon ordinateur portable.

    +1 bat ma façon de calculer dists de la matrice. C'est bien tour avec l'auto-réplication du vecteur ajoutée ou soustraite à partir de la matrice.
    Je suis en train d'utiliser votre solution, mais votre matrice transposée. Est-il un moyen de soustraire les lignes comme vous l'avez fait avec des colonnes?
    J'ai essayé la soustraction avec des lignes à l'aide de l'appliquer, mais il n'était pas si rapide que votre solution. Je suis maintenant à la transposition de la matrice et à l'aide de votre code, et il est vraiment rapide! Merci beaucoup!!! Et aussi, merci pour votre réponse complète avec un petit exemple et l'utilisation du système.temps. Merci beaucoup 🙂

    OriginalL'auteur Jonathan Chang

  2. 3

    que rdist() est une fonction R de {champs} package qui est capable de calculer la distance entre deux ensembles de points dans une matrice rapidement.

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

    Utilisation : 

    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

    OriginalL'auteur Deuterium

  3. 1

    Vous voudrez peut-être avoir un coup d'oeil dans le apply fonctions.

    Par exemple, ce code

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

    Peut facilement être remplacé par quelque chose comme

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

    Vous pouvez certainement l'optimiser plus, mais vous obtenez le point, je l'espère,

    Merci... C'est plus rapide que le premier code que j'ai écrit, mais pas même à proximité de l'étrange à l'aide de distance.
    eh bien, apparemment, le stats::kmeans package utilise le code compilé qui est évidemment plus rapide. Tapez simplement kmeans et vous allez voir le code source. 🙂

    OriginalL'auteur nico

  4. 1

    dist travaille vite parce que c'est pas vectorisé et d'appel interne les fonctions C.

    Vous de code dans la boucle pourrait être vectorisées dans de nombreuses façons.

    Par exemple pour calculer la distance entre data et centers vous pouvez utiliser outer:

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

    Cela vous donne n x K de la matrice de distances. Et devrait être de manière plus rapide que la boucle.

    Alors vous pouvez utiliser max.col pour trouver le maximum de chaque ligne (voir l'aide, il existe quelques nuances quand de nombreux maxima). X doit être nier la cause que l'on recherche pour un minimum.

    CL <- max.col(-X)

    Pour être efficace dans la R vous devriez vectorisé que possible. Boucles pourraient être dans de nombreux cas, remplacé par vectorisé substitut. Vérifiez l'aide pour rowSums (qui décrivent aussi rowMeans, colSums, rowSums), pmax, cumsum. Vous pourriez rechercher, par exemple
    https://stackoverflow.com/search?q=%5Br%5D+éviter de+boucle (copie&coller ce lien, je ne sais pas comment le rendre cliquable) pour des exemples.

    Salut, je suis en train d'utiliser votre code mais il ne fonctionne pas. J'ai essayé de l'utiliser avec le même code que @Jonathan Chang a écrit, en ajoutant: system.time(outer(seq_len(n), seq_len(K), function(i,j) sqrt(rowSums((x[,i]-centers[,j])^2)))), mais j'obtiens cette erreur: Error in dim(robj) <- c(dX, dY) : dims [product 38230] do not match the length of object [64] voyez-vous quel est le problème?
    En fait je n'étais pas la compréhension outer (je pensais que c'était l'appel de la fonction une fois pour chaque paire). Maintenant, je suis à la comprendre, je vous remercie, il peut être utile! Et aussi, merci pour raconter max.col.

    OriginalL'auteur Marek

  5. 0

    Ma solution:

    # 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)))
}

    Vous pouvez l'essayer, comme:

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

    OriginalL'auteur Adriano Rivolli