R: Trouver le plus court chemin géodésique entre 2 points d'un nuage de points 2D

Question

J'ai créé le graphique suivant à l'aide de deux fonctions écrites par Vincent Zoonekynd (vous pouvez les trouver here) (trouver mon code à la fin de la publication).

Afin d'être en mesure d'expliquer ce que graphe de voisinage et que le paramètre « k » est, que les utilisations Isometric Feature Mapping. "k" spécifie le nombre de points auxquels chaque point est directement connecté. Leur distance est juste la distance euclidienne l'une par rapport à l'autre. La distance entre un point quelconque et son (k + 1) Point -nearest (ou tout point plus éloigné) est appelé « géodésique », et est la plus petite somme de toutes les longueurs des arêtes nécessaire pour y parvenir. C'est parfois beaucoup plus long que la distance euclidienne. C'est le cas pour les points A et B de ma figure.

Maintenant, je veux ajouter une ligne noire indiquant la distance géodésique du point A au point B. Je sais que sur la commande segments(), qui sera probablement le meilleur pour ajouter la ligne, et je sais que l'un algorithme pour trouver le le plus court chemin (distance géodésique) est l'algorithme de Dijkstra et qu'il est implémenté dans le paquet igraph. Cependant, je ne suis ni en mesure d'avoir igraph interpréter mon graphique ni de connaître les points (sommets) qui doivent être transmis (et leurs coordonnées) sur mon propre. Par ailleurs, si k = 18, c'est-à-dire si chaque point est directement connecté aux 18 points les plus proches, la distance géodésique entre A et B sera juste la distance euclidienne.

---

isomap.incidence.matrix <- function (d, eps=NA, k=NA) { 
    stopifnot(xor(is.na(eps), is.na(k))) 
    d <- as.matrix(d) 
    if(!is.na(eps)) { 
    im <- d <= eps 
    } else { 
    im <- apply(d,1,rank) <= k+1 
    diag(im) <- FALSE 
    } 
    im | t(im) 
} 

plot.graph <- function (im,x,y=NULL, ...) { 
    if(is.null(y)) { 
    y <- x[,2] 
    x <- x[,1] 
    } 
    plot(x,y, ...) 
    k <- which( as.vector(im) ) 
    i <- as.vector(col(im))[ k ] 
    j <- as.vector(row(im))[ k ] 
    segments(x[i], y[i], x[j], y[j], col = "grey") 
} 

z <- seq(1.1,3.7,length=140)*pi 

set.seed(4) 
zz <- rnorm(1:length(z))+z*sin(z) 
zz <- cbind(zz,z*cos(z)*seq(3,1,length=length(z))) 

dist.grafik <- dist(zz) 

pca.grafik <- princomp(zz) 

x11(8, 8) 
par(mar=c(0,0,0,0)) 
plot.graph(isomap.incidence.matrix(dist.grafik, k=3), pca.grafik$scores[,1], pca.grafik$scores[,2], 
      xaxt = "n", yaxt = "n", xlab = "", ylab = "", cex = 1.3) 
legend("topright", inset = 0.02, legend = "k = 3", col = "grey", lty = 1, cex = 1.3) 
segments(x0 = -8.57, y0 = -1.11, x1 = -10.83, y1 = -5.6, col = "black", lwd = 2, lty = "dashed") 
text(x = -8.2, y = -1.4, labels = "A", font = 2, cex = 1.2) 
text(x = -11, y = -5.1, labels = "B", font = 2, cex = 1.2) 

Answer 1

Le code suivant peut vous aider, il utiliser vos données pour créer un objet igraph avec un poids qui sont dans votre cas, les distances euclidiennes entre les nœuds. Ensuite, vous trouverez le chemin le plus court pondéré qui est retourné par sp$vpath[[1]]. Dans l'exemple suivant, il est le plus court chemin entre les nœuds numéro 5 et 66. J'ai modifié le code avec la solution pour tracer de mattu

isomap.incidence.matrix <- function (d, eps=NA, k=NA) { 
    stopifnot(xor(is.na(eps), is.na(k))) 
    d <- as.matrix(d) 
    if(!is.na(eps)) { 
    im <- d <= eps 
    } else { 
    im <- apply(d,1,rank) <= k+1 
    diag(im) <- FALSE 
    } 
    im | t(im) 
} 

plot.graph <- function (im,x,y=NULL, ...) { 
    if(is.null(y)) { 
    y <- x[,2] 
    x <- x[,1] 
    } 
    plot(x,y, ...) 
    k <- which( as.vector(im) ) 
    i <- as.vector(col(im))[ k ] 
    j <- as.vector(row(im))[ k ] 
    segments(x[i], y[i], x[j], y[j], col = "grey") 
} 

z <- seq(1.1,3.7,length=100)*pi 

set.seed(4) 
zz <- rnorm(1:length(z))+z*sin(z) 
zz <- cbind(zz,z*cos(z)*seq(3,1,length=length(z))) 

dist.grafik <- as.matrix(dist(zz)) 
pca.grafik <- princomp(zz) 

isomap.resul <- function (d, eps=NA, k=NA) { 
    a <- isomap.incidence.matrix(d, eps, k) 
    b <- dist.grafik 
    res <- a * b 
    return(res) 
} 

a <- graph_from_adjacency_matrix(isomap.resul(dist.grafik, k=3), 
           mode = c("undirected"), weight = TRUE) 
sp <- shortest_paths(a, 5, to = 66, mode = c("out", "all", "in"), 
        weights = NULL, output = c("vpath", "epath", "both"), 
        predecessors = FALSE, inbound.edges = FALSE) 

path <- sp$vpath[[1]] 

x11(8, 8) 
par(mar=c(0,0,0,0)) 
plot.graph(isomap.incidence.matrix(dist.grafik, k=3), pca.grafik$scores[,1], pca.grafik$scores[,2], 
      xaxt = "n", yaxt = "n", xlab = "", ylab = "", cex = 1.3) 
legend("topright", inset = 0.02, legend = "k = 3", col = "grey", lty = 1, cex = 1.3) 
segments(x0 = -8.57, y0 = -1.11, x1 = -10.83, y1 = -5.6, col = "black", lwd = 2, lty = "dashed") 
text(x = -8.2, y = -1.4, labels = "A", font = 2, cex = 1.2) 
text(x = -11, y = -5.1, labels = "B", font = 2, cex = 1.2) 

for(i in 2:length(path)){ 
    aa <- pca.grafik$scores[path[i-1], 1] 
    bb <- pca.grafik$scores[path[i-1], 2] 
    cc <- pca.grafik$scores[path[i], 1] 
    dd <- pca.grafik$scores[path[i], 2] 
    segments(aa, bb, cc , dd, lwd = 2) 
} 

Pour exécuter ce script, vous devez évidemment le paquet igraph.

Pour moi, il semble que le chemin le plus court en fonction de la distance géodésique.

Hope it helps.