Comment puis-je vectoriser ce code dans R? Peut-être avec la fonction apply ()?

Question

Je suis vraiment du mal à reproduire la sortie de la fonction dist () dans le code R sans utiliser 1 ou 2 pour les boucles. (Si vous vous demandez pourquoi je fais cela, il est pour que je puisse jouer avec le calcul de la distance, et aussi d'améliorer mes compétences en R - Veuillez donc remplir que des solutions qui impliquent R)

Vue d'ensemble: matrice est transmis à dist () qui calcule la distance euclidienne de rangée par rangée et émet en sortie une matrice complète à distance de la distance entre chaque rangée (par exemple, la distance entre les lignes 1 et 50 sera en distancematrix [1, 50] et distancematrix [50, 1]). Le look de code rapide comme celui-ci:

distancematrix <- as.matrix(dist(myMatrix, method="euclidean", diag = T, upper = T))

I ai réussi à produire la même sortie en utilisant le code R qui suit:

for (i in 1:nrow(myMatrix)) {
  for (j in 1:nrow(myMatrix)) {
    distancematrix[i, j] <- sum(abs(myMatrix[i,] - myMatrix[j,])) 
  }
}

Cependant, en utilisant deux boucles imbriquées pour est beaucoup plus lente que dist (). J'ai lu beaucoup sur l'utilisation apply () afin d'optimiser plus lent pour les boucles, mais je ne l'ai pas été en mesure d'obtenir ma tête autour d'elle jusqu'à présent. Je crois qu'au moins l'un des pour les boucles est certainement évitable par un vecteur juste sortir et traiter à la fin. Cependant, je ne peux pas pour la vie de me trouver comment supprimer à la fois pour les boucles.

Est-ce que quelqu'un a des pensées?

Answer 1

D'abord il convient de noter que le code affiché ne répliquent pas réellement la sortie de la fonction dist, parce que la ligne:

distancematrix[i, j] <- sum(abs(myMatrix[i,] - myMatrix[j,]))

ne calcule pas la distance euclidienne; il devrait être:

distancematrix[i, j] <- sqrt(sum((myMatrix[i,] - myMatrix[j,]) ^ 2))

Voici deux solutions qui reposent sur apply. Ils sont simplifiées, et en particulier ne profitent pas de la symétrie de la matrice de distance (qui, si elle est considérée, conduirait à une accélération 2 fois). Tout d'abord, générer des données de test:

# Number of data points
N <- 2000
# Dimensionality
d <- 10
# Generate data
myMatrix = matrix(rnorm(N * d), nrow = N)

Pour plus de commodité, définir:

# Wrapper for the distance function
d_fun <- function(x_1, x_2) sqrt(sum((x_1 - x_2) ^ 2))

La première approche est une combinaison de apply et sapply:

system.time(
    D_1 <- 
        apply(myMatrix, 1, function(x_i) 
            sapply(1:nrow(myMatrix), function(j) d_fun(x_i, myMatrix[j, ]))
    )
)

   user  system elapsed 
 14.041   0.100  14.001 

tandis que le second ne utilise que apply (mais sur les indices allant, qui sont liés via expand.grid):

system.time(
    D_2 <- 
        matrix(apply(expand.grid(i = 1:nrow(myMatrix), j = 1:nrow(myMatrix)), 1, function(I) 
            d_fun(myMatrix[I[["i"]], ], myMatrix[I[["j"]], ])
        )
    )
)

   user  system elapsed 
 39.313   0.498  39.561 

Cependant, comme prévu deux sont beaucoup plus lent que dist:

system.time(
    distancematrix <- as.matrix(
        dist(myMatrix, method = "euclidean", diag = T, upper = T)
    )
)

   user  system elapsed 
  0.337   0.054   0.388