基于igraph的大型含环有向无权重图最长与平均简单路径高效计算咨询

背景与已完成工作 #

我目前使用R语言的igraph包开展网络分析（也接受Python语言的解决方案），处理的是可能含环的有向无权重图（无重复边），每张图的节点规模在1000至1000000个之间。

已完成以下工作：

• 识别出图中的起始节点（无入边的节点）、终止节点（无出边的节点）
• 筛选出所有连通起止节点对（即存在路径从起始节点到终止节点的节点对）

举个例子：

• 起始节点：A、E
• 终止节点：C、F
• 连通起止节点对：(A,C)、(A,F)、(E,F)

已通过igraph的shortest.paths函数成功计算出各连通起止节点对的最短路径长度（路径长度定义为路径包含的边数），示例结果如下：

start_name | end_name | shortest path length
A          | C        | 2
A          | F        | 2
E          | F        | 1

需求 #

现在需要计算各连通起止节点对的：

• 最长简单路径长度
• 平均简单路径长度

预期结果示例如下：

start_name | end_name | shortest path length | longest path length | avg path length
A          | C        | 2                    | 3                   | 2.5
A          | F        | 2                    | 2                   | 2.0
E          | F        | 1                    | 1                   | 1.0

现有方案的问题 #

我的初始方案是使用all_simple_paths函数：

1. 生成起止节点对之间的所有简单路径
2. 统计路径长度的最大值与平均值

但该方法在处理大型图时耗时极长，我了解到这种方法的时间复杂度随节点数呈指数增长（非计算机专业，对时间复杂度了解有限）。因此有以下疑问：

1. 这个计算项目是否可行？若可行，预期的计算时长大概是多少？（已知数小时内无法完成，是否需要数周甚至数月？）
2. 有没有替代方法或优化方案，可以高效计算大型有向图中起止节点对的最长与平均简单路径长度？

示例代码 #

# Example code to identify starting and ending nodes
library(tidyverse)
library(igraph)

# Create a sample graph
g_data <- data.frame(from = c("A", "B", "B", "D", "B", "E"),
                     end  = c("B", "C", "D", "C", "F", "F"))
g <- graph_from_data_frame(g_data, directed = TRUE)

V(g)
V(g)$name
plot(g)

# Identify starting nodes (nodes without incoming edges)
starting_nodes <- V(g)[which(degree(g, mode = "in") == 0)]

# Identify ending nodes (nodes without outgoing edges)
ending_nodes <- which(degree(g, mode = "out") == 0)

# Find all connected start-end pairs (vertex id, not name)
connected_pairs <- expand.grid(starting_nodes, ending_nodes)
colnames(connected_pairs) <- c("start", "end")

connected_pairs <- connected_pairs %>% mutate(start_name = V(g)$name[start],
                                              end_name = V(g)$name[end])

# Calculate the shortest path
connected_pairs$shortest_path_length <- sapply(1:nrow(connected_pairs), function(i) {
  distances(g, connected_pairs[i,]$start, connected_pairs[i,]$end, mode = "out")
})

# Delete unconncected pairs
connected_pairs <- connected_pairs[connected_pairs$shortest_path_length != Inf, ]

# Longest path length
connected_pairs$longest_path_length <- sapply(1:nrow(connected_pairs), function(i) {
  all_paths <- all_simple_paths(g, connected_pairs[i,]$start, connected_pairs[i,]$end, mode = "out")
  num_all_paths <- length(all_paths)
  
  all_paths_length <- sapply(1:length(all_paths), function(x) {
    length(all_paths[[x]]) - 1
  })
  
  return(max(all_paths_length))
})

# Average path length
connected_pairs$avg_path_length <- sapply(1:nrow(connected_pairs), function(i) {
  all_paths <- all_simple_paths(g, connected_pairs[i,]$start, connected_pairs[i,]$end, mode = "out")
  num_all_paths <- length(all_paths)
  
  all_paths_length <- sapply(1:length(all_paths), function(x) {
    length(all_paths[[x]]) - 1
  })
  
  return(mean(all_paths_length))
})

内容的提问来源于stack exchange，提问作者Cecile