使用 igraph 分配网络旅行

Question

我的问题：

我有一个街道网络 (df.net) 和一个包含旅行起点和终点的列表 (df.trips)。

我需要找到所有链接上的流？

library(dplyr)

df.net = tribble(~from, ~to, ~weight,1,2,1,2,1,1,1,9,3,9,1,2,2,10,1,10,2,2,9,10,8,10,9,15,9,8,1,8,9,2,7,8,2,12,7,3,9,12,10,12,9,9,12,6,2,6,12,5,11,12,3,12,11,3,5,6,1,11,5,4,5,11,3,11,4,3,4,3,5,3,10,4,10,11,10)

df.trips = tribble(~from, ~to, ~N,1,2,45,1,4,24,1,5,66,1,9,12,1,11,54,2,3,63,2,4,22,2,7,88,2,12,44,3,2,6,3,8,43,3,10,20,3,11,4,4,1,9,4,5,7,4,6,35,4,9,1,5,7,55,5,8,21,5,1,23,5,7,12,5,2,18,6,2,31,6,3,6,6,5,15,6,8,19,7,1,78,7,2,48,7,3,92,7,6,6,8,2,77,8,4,5,8,5,35,8,6,63,8,7,22)

这是我的解决方案：

library(igraph)

# I construct a directed igraph network:
graph = igraph::graph_from_data_frame(d=df.net, directed=T)
plot(graph)

# I make a vector of edge_ids:
edges = paste0(df.net$from,":",df.net$to)

# and an empty vector of same length to fill with the flow afterwards:
N = integer(length(edges))

# I loop through all Origin-Destination-pairs:
for(i in 1:nrow(df.trips)){

  # provides one shortest path between one Origin & one Destination:
  path = shortest_paths(graph = graph, 
                         from = as.character(df.trips$from[i]), 
                         to = as.character(df.trips$to[i]), 
                         mode = "out", 
                         weights = NULL)

  # Extract the names of vetices on the path:
  a = names(path$vpath[[1]])

  # Make a vector of the edge_ids:  
  a2 = a[2:length(a)]
  a = a[1:(length(a)-1)]
  a = paste0(a,":",a2)  

  # and fill the vector with the trips
  v = integer(length(edges))
  v[edges %in% a] = pull(df.trips[i,3])

  # adding the trips of this iteration to the sum
  N = N + v

}

# attach vector to network-dataframe:
df.net = data.frame(df.net, N)

理论上它是有效的。它只需要大约。我的真实网络需要 8 小时才能完成（网络上大约有 500 000 个 Origin-Destination-pairs，链接少于 50 000 个）。

我很确定我的 for 循环是罪魁祸首。

所以我关于优化的问题是：

1) 是否有一个 igraph 函数可以简单地完成我想做的事情？没找到……

2) 也许还有另一个我没有偶然发现的更适合我的需求的包？

3) 如果不是，我应该通过使用 Rcpp 包重写它来提高循环性能吗？

无论如何，我很感激你能为我提供的任何帮助。 提前致谢！

Answer 1

我希望有一个更快的解决方案，尽管我从你那里得到的结果略有不同。

此方法使用data.table 进行多线程处理，每个顶点仅调用一次igraph::shorest_paths，并避免使用图形的名称属性，直到最后一步。

library(igraph)
library(tibble)
library(data.table)
library(zoo)
library(purrr)
df.net = tribble(~from, ~to, ~weight,1,2,1,2,1,1,1,9,3,9,1,2,2,10,1,10,2,2,9,10,8,10,9,15,9,8,1,8,9,2,7,8,2,12,7,3,9,12,10,12,9,9,12,6,2,6,12,5,11,12,3,12,11,3,5,6,1,11,5,4,5,11,3,11,4,3,4,3,5,3,10,4,10,11,10)
graph = igraph::graph_from_data_frame(d=df.net, directed=T)
df.trips = tribble(~from, ~to, ~N,1,2,45,1,4,24,1,5,66,1,9,12,1,11,54,2,3,63,2,4,22,2,7,88,2,12,44,3,2,6,3,8,43,3,10,20,3,11,4,4,1,9,4,5,7,4,6,35,4,9,1,5,7,55,5,8,21,5,1,23,5,7,12,5,2,18,6,2,31,6,3,6,6,5,15,6,8,19,7,1,78,7,2,48,7,3,92,7,6,6,8,2,77,8,4,5,8,5,35,8,6,63,8,7,22)
l.trips <- split(df.trips,1:nrow(df.trips))


setDT(df.trips)
Result <- df.trips[,setnames(lapply(shortest_paths(graph = graph,from= from,to = to,weights=NULL,mode = "out")$vpath,
                 function(x){zoo::rollapply(x,width=2,c)}) %>% map2(.,N,~ {.x %x% rep(1,.y)} %>% as.data.frame) %>%
           rbindlist %>% .[,.N,by = c("V1","V2")],c("new.from","new.to","N")),by=from][,sum(N),by = c("new.from","new.to")]
Result[,`:=`(new.from = V(graph)$name[Result$new.from],
             new.to = V(graph)$name[Result$new.to])]
#   new.from new.to  V1
# 1:        1      2 320
# 2:        2     10 161
# 3:        1      9 224
# 4:        9      8  73
# 5:       10     11 146
# 6:       11      4 102
# 7:        2      1 167
# 8:        9     12 262
# 9:        4      3  44
#10:        9      1 286
#11:       12      6  83
#12:       12     11  24
#13:       11      5  20
#14:       10      2  16
#15:       11     12  35
#16:       12      7 439
#17:        8      9 485
#18:        7      8 406
#19:        6     12 202