我在Vincent Zoonekynd写的两个函数的帮助下创建了下面的图形(你可以找到它们here)(在帖子的末尾找到我的代码)。
为了能够解释那个邻域图和那个参数" k"是Isometric Feature Mapping使用的。 " K"指定每个点直接连接的点数。它们的距离只是彼此的欧几里德距离。任何点与其(k + 1) - 最近点(或任何更远点)之间的距离称为"测地线",并且是到达那里所需的所有边长度的最小和。这有时比欧几里德距离长得多。这是我图中A点和B点的情况。
现在我想添加一条黑线,显示从A点到B点的测地距离。我知道命令segments()
,这可能是最好的添加线,我知道一个算法找到最短路径(测地距离)是Dijkstra的算法,它是在包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)
答案 0 :(得分:2)
以下代码可以帮助您,它使用您的数据创建一个砝码,在您的情况下具有权重,节点之间的欧氏距离。
然后你会找到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
。
希望它有所帮助。