Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

The built-in FindShortestPath and GraphDistance functions find the shortest path between two particular vertices in a graph. I can't think of a simple way to finding all shortest paths between two vertices. Any ideas?

My graph has weighted edges and the weights are arbitrarily large, so I'm dead against mapping weighted edges to many unweighted edges.

Motivation: I have a graph of city traffic routes from point A to point B. I'd like to take the union of shortest paths from A to B to get a subgraph that, I posit, contains (many of) the most frequented intersections.

share|improve this question
1  
@ruebenko: How would you apply Nearest to this problem? –  celtschk Apr 11 '12 at 9:01
1  
There is similar question stackoverflow.com/questions/2819347/… . The third answer is not a bad idea. –  PlatoManiac Apr 11 '12 at 9:09
3  
The documentation for BreadthFirstScan has an example of this problem under Examples-Applications-Shortest Path Applications. –  Simon Woods Apr 11 '12 at 9:31
2  
Thinking about it, to get the union of shortest paths you probably don't need the set of shortest paths. I think the following algorithm should give you the union: Step 1: For each node, calculate the graph distance both to the start vertex A and the destination vertex B (let's call those values the A-distance and B-distance of that vertex). Step 2: Remove all edges whose weight is not both the difference between the A-distances of the vertices it connects and the difference between the B-distances. If I'm not wrong, the resulting graph should be exactly the union of all shortest paths. –  celtschk Apr 11 '12 at 9:43
2  
@SimonWoods The example with BreadthFirstScan works for very small toy problems but even for GridGraph with dimension $12 \times 14$ memory consumption increases with out bound. –  PlatoManiac Apr 11 '12 at 9:57
show 10 more comments

3 Answers

up vote 8 down vote accepted

Directed Shortest Paths

Here's a friendly amendment to Heike's solution that shows the distance remaining to the finish vertex (in white). The starting vertex is green. Edges are directed to show the appropriate direction toward the finish.

First, here's Heike's routine, which does most of the heavy lifting, with a simple tweak to produce directed edges:

paths[gr_, {i_, j_}] := 
  Module[{sub, dist, indices, dd, nbrs}, dist = GraphDistance[gr, i, j];
  indices = {};
  dd = dist;
  Reap[Nest[Function[{vv}, dd -= 1;
  nbrs = VertexList[NeighborhoodGraph[gr, #]] & /@ vv;
  nbrs = Pick[#, GraphDistance[gr, #, j] & /@ #, dd] & /@ nbrs;
  Sow /@ Flatten[Thread /@ Thread[vv \[DirectedEdge] nbrs]];
  Union[Flatten[nbrs]]], {i}, dist]][[2, 1]]]

The following produces the directional routes. Numbers refer to GraphDistance from the current vertex to the finish vertex.

gr = RandomGraph[{30, 40}];
ends = {1, 30};
sub = paths[gr, ends];
e = EdgeList[gr] /. {x_ \[UndirectedEdge] y_ /; 
 GraphDistance[gr, x, 30] < GraphDistance[gr, y, 30] :> y \[DirectedEdge] x, 
   x_ \[UndirectedEdge] y_ /; 
 GraphDistance[gr, y, 30] <= GraphDistance[gr, x, 30] :>  x \[DirectedEdge] y}
gr1 = Graph[e, ImagePadding -> 15];

HighlightGraph[gr1, {Graph[sub], Style[1, Green], Style[30, White]}, 
 VertexLabels ->  Table[i -> Style[GraphDistance[gr1, i, 30], 16], {i, 
    Union[Level[sub, {-1}]]}], 
    VertexSize -> {1 -> Large, 30 -> Large}, 
    GraphHighlightStyle -> "Thick", ImagePadding -> 15]

directed graph


Below is a variant that displays (a) the vertex indices (small font size) and the distance from the finish vertex on the EdgeLabel (large font).

HighlightGraph[gr1, {Graph[sub], Style[1, Green], Style[30, White]}, 
   VertexLabels -> (v = Union[Level[sub, {-1}]]) /. {i_Integer :> (i -> i)},
   EdgeLabels -> sub /. {x_ \[DirectedEdge] y_ :> (x \[DirectedEdge] y) -> 
   Style[ GraphDistance[gr, x, 30], 14, Background -> White]},
   VertexSize -> {1 -> Large, 30 -> Large}, 
   GraphHighlightStyle -> "Thick", ImagePadding -> 15, ImageSize -> 600]

directed graph 2

share|improve this answer
    
Any such crossing can be handled by recognizing that there are two or more ways to reach it, all have the same length, and so the problem can be split into subproblems. Specifically, we'll have the Cartesion product of min paths from start to crossing and min paths from crossing to finish. Also one must account for min paths that do not hit the crossing vertex. All that said, labeling by distance to finish seems like a useful thing to have. –  Daniel Lichtblau Apr 12 '12 at 16:53
    
I'm wondering about "Any such crossing can be handled by recognizing that there are two or more ways to reach it, all have the same length". There may be only one way to reach the crossing (from a pre-selected start node); namely, if the in-degree is one. Note: I'm considering the union of shortest paths to be a directed sub-graph. By the way, is it possible for MMA to diagram a graph with a mix of directed and undirected edges. (I know multi graphs are not supported, but I would have thought that as long as there are no loops, and no more than a single edge between a pair of vertices...) –  David Carraher Apr 12 '12 at 17:34
    
Correct about in-degree of one. I should have been more explicit. I had in mind the case where you cannot get to the finish minimally by taking ANY of the edges leading out (that is, not the one you took in to the vertex). This was in accord with your concern that one might have to choose from amongst a proper subset, which does not happen when in-degree is one. –  Daniel Lichtblau Apr 12 '12 at 18:23
add comment

To get the union of the shortest paths from i to j in graph gr you could do something like this

paths[gr_, {i_, j_}] := Module[{sub, dist, indices, dd, nbrs},
  dist = GraphDistance[gr, i, j];
  indices = {};
  dd = dist;
  Reap[Nest[
     Function[{vv},
      dd -= 1;
      nbrs = VertexList[NeighborhoodGraph[gr, #]] & /@ vv;
      nbrs = Pick[#, GraphDistance[gr, #, j] & /@ #, dd] & /@ nbrs;
      Sow /@ Flatten[Thread /@ Thread[vv \[UndirectedEdge] nbrs]];
      Union[Flatten[nbrs]]
      ], {i}, dist]][[2, 1]]]

This method works by selecting all neighbours of i whose distance to j is one less than the minimal distance from i to j. For each vertex in this list we then select the neighbours whose distance to j is two less than the minimal distance, etc. until we reach j.

Usage

gr = RandomGraph[{30, 50}];
ends = {1, 30};
sub = paths[gr, ends];
HighlightGraph[gr, {Graph[sub], Style[ends, Green]}]

Mathematica graphics

share|improve this answer
    
Nice work, but there is a directionality issue to be considered. First, the start vertex and and end vertex need to be distinguished. In addition, I believe the highlighted edges need to be directed edges. Otherwise, the "driver" in the middle of traffic cannot necessarily know which direction to take when arriving at a vertex with degree >1. (Some edges may lead back toward the start; others may lead towards the finish.) –  David Carraher Apr 12 '12 at 2:30
add comment
findMinPathsPoints[k_, ends_] := Module[{dist},
   dist = (GraphDistance[k, #[[1]]] + GraphDistance[k, #[[2]]]) &@ends;
   Complement[Flatten@Position[dist, Min[dist]], ends]];

(*Usage*)

n = 50;
points = {1, 10};
k = PetersenGraph[n, IntegerPart[n/4]]

Subgraph[k, Range@VertexCount@k, VertexStyle -> 
          Join[
              (# -> Red &)    /@ points, 
              (# -> Yellow &) /@ findMinPathsPoints[k, points]]]

enter image description here

share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.