如何求最短路径矩阵？

Question

我有一个加权邻接矩阵 m 我需要找到最短路径矩阵。预期结果是：

library(igraph)

n = 8
m <- t(matrix(c(
0,0,0,0,0,0,0,8,
3,0,0,0,0,0,0,0,
5,0,0,5,1,0,0,0,
0,0,6,0,0,7,1,0,
0,6,2,0,0,0,0,0,
0,0,0,0,0,0,0,0,
7,4,0,0,8,0,0,3,
0,3,0,0,0,9,0,0),ncol=n))

g1 <- graph_from_adjacency_matrix(m, weighted=TRUE, mode="directed")

V(g1)$names <-  letters[1:n]
plot(g1, vertex.label = V(g1)$names, edge.arrow.size=0.5)

我的尝试是：

path_name <- c()

for (i in c(1,2,6,8)){
for (path in all_simple_paths(g1, i, V(g1), mode="out")) {
       path_name <- c(path_name, paste(V(g1)[path]$names, collapse='')); 
}
}
path_name
    [1] "ah"   "ahb"  "ahf"  "ba"   "bah"  "bahf" "hb"   "hba"  "hf"

可以看到我已经找到了四个节点的路径：1、2、5、6，名称为 a、b、f、h。如果以a、b、h为起始节点，则每个节点可以获得3条路径，而h则没有路径。

问题如何重建所有节点的路径？ 我没有找到 Lee（波）算法。

Answer 1

您可以尝试下面的代码

m <- d <- distances(g1, mode = "out")
for (i in row.names(d)) {
    for (j in colnames(d)) {
        if (i != j) {
            if (!is.infinite(d[i, j])) {
                m[i, j] <- paste0(names(shortest_paths(g1, i, j)$vpath[[1]]), collapse = "")
            } else {
                m[i,j] <- NA
            }
        } else {
            m[i, j] <- ""
        }
    }
}

，您将看到最短路径矩阵m

> m
  a     b     c     d      e     f      g      h
a ""    "ahb" NA    NA     NA    "ahf"  NA     "ah"
b "ba"  ""    NA    NA     NA    "bahf" NA     "bah"
c "ca"  "ceb" ""    "cd"   "ce"  "cdf"  "cdg"  "cdgh"
d "dga" "dgb" "dc"  ""     "dce" "df"   "dg"   "dgh"
e "eca" "eb"  "ec"  "ecd"  ""    "ecdf" "ecdg" "ecdgh"
f NA    NA    NA    NA     NA    ""     NA     NA
g "ga"  "gb"  "gec" "gecd" "ge"  "ghf"  ""     "gh"
h "hba" "hb"  NA    NA     NA    "hf"   NA     "" 

Answer 2

您可以使用 igraph::all_shortest_paths ，但是，除非我遗漏了某些内容，否则重建矩阵仍然很棘手。

编辑：清理 purrr 部分

library(purrr)
library(igraph)
n = 8
m <- t(matrix(c(
0,0,0,0,0,0,0,8,
3,0,0,0,0,0,0,0,
5,0,0,5,1,0,0,0,
0,0,6,0,0,7,1,0,
0,6,2,0,0,0,0,0,
0,0,0,0,0,0,0,0,
7,4,0,0,8,0,0,3,
0,3,0,0,0,9,0,0),ncol=n))

g1 <- graph_from_adjacency_matrix(m, weighted=TRUE, mode="directed")

V(g1)$names <-  letters[1:n]

v <- 1:n

mat <- matrix("",
              nrow = n,
              ncol = n,
              dimnames = list(V(g1)$names, V(g1)$names))

map(v, ~all_shortest_paths(g1, .x, v[-.x], mode = "out")) |>
  map(chuck, "res") |>
  compact() |>
  map_depth(~{V(g1)$names[as.vector(.x)]}, .depth = 2) |>
  flatten() |>
  walk(~{
    mat[first(.x), last(.x)] <<- paste(.x, collapse = "")
  })

mat
  
##>   a      b     c     d      e     f      g      h      
##> a ""     "ahb" ""    ""     ""    "ahf"  ""     "ah"   
##> b "ba"   ""    ""    ""     ""    "bahf" ""     "bah"  
##> c "ca"   "ceb" ""    "cd"   "ce"  "cdf"  "cdg"  "cdgh" 
##> d "dgba" "dgb" "dc"  ""     "dce" "df"   "dg"   "dgh"  
##> e "eca"  "eb"  "ec"  "ecd"  ""    "ecdf" "ecdg" "ecdgh"
##> f ""     ""    ""    ""     ""    ""     ""     ""     
##> g "gba"  "gb"  "gec" "gecd" "ge"  "ghf"  ""     "gh"   
##> h "hba"  "hb"  ""    ""     ""    "hf"   ""     ""