R: Найдите кратчайший геодезический путь между двумя точками облака с 2-мя точками

Question

Я создал следующий график с помощью двух функций, написанных Винсеном Зоонейндом (вы можете найти их here) (найти мой код в конце сообщения).

Для того, чтобы быть в состоянии объяснить, что это соседство графа и что параметр «К», которую Isometric Feature Mapping использует. «k» указывает, на сколько точек каждая точка напрямую связана. Их расстояние - это просто эвклидово расстояние друг к другу. Расстояние между любой точкой и ее (k + 1) -нейшей точкой (или любой точкой дальше) называется «геодезической» и является наименьшей суммой всех длин ребер, необходимых для ее получения. Это иногда намного дольше, чем эвклидово расстояние. Это касается точек A и B на моем рисунке.

Теперь я хочу добавить черную линию, показывающую геодезическое расстояние от точки А до точки В. Я знаю о команде segments(), которая, вероятно, будет лучшей для добавления строки, и я знаю, что один алгоритм для поиска кратчайший путь (геодезическое расстояние) является алгоритмом Дейкстры и что он реализован в пакете igraph. Тем не менее, я не могу иметь igraph интерпретировать мой график или не обнаруживать точки (вершины), которые необходимо передать (и их координаты) самостоятельно.

Кстати, если k = 18, т. Е. Если каждая точка напрямую связана с 18 ближайшими точками, то геодезическое расстояние между A и B будет просто эвклидовым расстоянием.

---

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

Следующий код может помочь вам, это использовать ваши данные для создания объекта igraph с весом, которые находятся в вашем случае, евклидовых расстояний между узлами. Затем вы найдете взвешенный короткий путь, который возвращается sp$vpath[[1]]. В следующем примере, это кратчайший путь между узлами № 5 и 66. я редактировал код решения для построения из 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) 
} 

Чтобы запустить этот сценарий, вы, очевидно, нужен пакет igraph.

Для меня это самый короткий путь по геодезическому расстоянию.

Надеюсь, это поможет.