基于图边属性的最短路径
基于图边属性的最短路径
提问于 2018-05-11 16:28:14
我试图获得一个图的最短路径，但基于它的边ids。因此，请看下面的图表：
library(igraph)
set.seed(45)
g <- erdos.renyi.game(25, 1/10, directed = TRUE)
E(g)$id <- sample(1:3, length(E(g)), replace = TRUE)shortest_paths(g, 1, V(g))函数查找从节点1到所有其他节点的所有最短路径。然而，我想要计算这个，不仅仅是通过遵循测地距离，而是测地距离和边id变化的最小值之间的混合。例如，如果这将是一个列车网络，并且边缘ids将表示列车。我想计算如何使用最短路径从节点A到达所有其他节点，但同时改变列车的最少时间量。
回答 2
Stack Overflow用户
发布于 2018-05-11 21:21:47
好吧，我想我有一个可行的解决方案，尽管代码有点丑陋。基本算法(让我们称之为gs(i，j))是这样的:如果我们想要找到从i到j (gs(i，j))的最短火车行程，我们：
- 找出从i到j的考虑所有列车的最短路径。如果此路径的长度为0或1，则返回它(在1列火车上不存在路径或一条路径)
- 通过'trains‘(边的子集)将图分割，以便单独考虑每个火车网络，并在每个单独的火车网络中找到i和j之间的最短路径
- 如果单个火车将使你从i到j，则返回i和j之间停靠最少的火车路线，否则
- 如果没有单个火车从i到j运行，则调用gs(i，j-1)其中(j-1)是全网络上i和j之间的最短路径中j之前的停靠点。
所以基本上，我们看一看一列火车是否可以做到，如果不能，我们递归地调用函数，看看一列火车是否能让你在最后一站之前到达停靠站，等等。
library(igraph)
# First your data
set.seed(45)
g <- erdos.renyi.game(25, 1/10, directed = TRUE)
E(g)$id <- sample(1:3, length(E(g)), replace = TRUE)
plot(g, edge.color = E(g)$id)
# The function takes as arguments the graph, and the id of the vertex
# you want to go from/to. It should work for a vector of
# destinations but I have not rigorously tested it so proceed with
# caution!
get.shortest.routes <- function(g, from, to){
train.routes <- lapply(unique(E(g)$id), function(id){subgraph.edges(g, eids = which(E(g)$id==id), delete.vertices = F)})
target.sp <- shortest_paths(g, from = from, to = to, output = 'vpath')$vpath
single.train.paths <- lapply(train.routes, function(gs){shortest_paths(gs, from = from, to = to, output = 'vpath')$vpath})
for (i in length(target.sp)){
if (length(target.sp[[i]]>1)) {
cands <- lapply(single.train.paths, function(l){l[[i]]})
if (sum(unlist(lapply(cands, length)))!=0) {
cands <- cands[lapply(cands, length)!=0]
cands <- cands[lapply(cands, length)==min(unlist(lapply(cands, length)))]
target.sp[[i]] <- cands[[1]]
} else {
target.sp[[i]] <- c(get.shortest.routes(g, from = as.numeric(target.sp[[i]][1]),
to = as.numeric(target.sp[[i]][(length(target.sp[[i]]) - 1)]))[[1]],
get.shortest.routes(g, from = as.numeric(target.sp[[i]][(length(target.sp[[i]]) - 1)]),
to = as.numeric(target.sp[[i]][length(target.sp[[i]])]))[[1]][-1])
}
}
}
target.sp
}好了，现在让我们运行一些测试。如果你斜眼看上面的图表，你可以看到如果你坐两列火车，从顶点5到顶点21的路径长度是-2，但是如果你经过一个额外的车站，你可以乘坐一列火车到达那里。我们的新函数应该返回更长的路径：
shortest_paths(g, 5, 21)$vpath
#> [[1]]
#> + 3/25 vertices, from b014eb9:
#> [1] 5 13 21
get.shortest.routes(g, 5, 21)
#> Warning in shortest_paths(gs, from = from, to = to, output = "vpath"): At
#> structural_properties.c:745 :Couldn't reach some vertices
#> Warning in shortest_paths(gs, from = from, to = to, output = "vpath"): At
#> structural_properties.c:745 :Couldn't reach some vertices
#> [[1]]
#> + 4/25 vertices, from c22246c:
#> [1] 5 13 15 21让我们做一个非常简单的图，其中我们确定我们想要看到的:这里我们应该得到1-2-4-5而不是1-3-5：
df <- data.frame(from = c(1, 1, 2, 3, 4), to = c(2, 3, 4, 5, 5))
g1 <- graph_from_data_frame(df)
E(g1)$id <- c(1, 2, 1, 3, 1)
plot(g1, edge.color = E(g1)$id)
get.shortest.routes(g1, 1, 5)
#> Warning in shortest_paths(gs, from = from, to = to, output = "vpath"): At
#> structural_properties.c:745 :Couldn't reach some vertices
#> Warning in shortest_paths(gs, from = from, to = to, output = "vpath"): At
#> structural_properties.c:745 :Couldn't reach some vertices
#> [[1]]
#> + 4/5 vertices, named, from c406649:
#> [1] 1 2 4 5我确信有一个更严格的解决方案，您可能希望对代码进行一些优化。例如，我刚刚意识到，如果完整图上的最短路径只有两个节点，我不会立即停止函数--这样做可以避免一些不必要的计算！这是一个有趣的问题，我希望能发布一些其他的答案。
由reprex package创建于2018-05-11 (v0.2.0)。
Stack Overflow用户
发布于 2018-05-16 02:40:54
这是我对这个问题的看法。以下是一些注意事项：
1) all_simple_paths不能很好地扩展到大图或高连接图
2)我最喜欢最少的更改，这意味着具有两个更改且dist为40的路径将击败具有三个更改且dist为3的路径。
4)如果一个id上没有路径，如果更改次数和距离更改优先级，我可以想象一种更快的方法
library(igraph)
# First your data
set.seed(45)
g <- erdos.renyi.game(25, 1/10, directed = TRUE)
E(g)$id <- sample(1:3, length(E(g)), replace = TRUE)
plot(g, edge.color = E(g)$id)
##Option 1:
rst <- all_simple_paths(g, from = 1, to = 18, mode = "out")
rst <- lapply(rst, as_ids)
rst1 <- lapply(rst, function(x) c(x[1], rep(x[2:(length(x)-1)],
each=2), x[length(x)]))
rst2 <- lapply(rst1, function(x) data.frame(eid = get.edge.ids(graph=g, vp = x),
train=E(g)$id[get.edge.ids(graph=g, vp = x)]))
rst3 <- data.frame(pathID=seq_along(rst),
changes=sapply(rst2, function(x) length(rle(x$train)$lengths)),
dist=sapply(rst2, nrow))
spath <- rst3[order(rst3$changes, rst3$dist), ][1,1]
#Vertex IDs
rst[[spath]]
#[1] 1 23 8 18
plot(g, edge.color = E(g)$id, vertex.color=ifelse(V(g) %in% rst[[spath]], "firebrick", "gray80"),
edge.arrow.size=0.5)
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/50288178
复制相关文章
相似问题
腾讯云开发者
