graphs and networks - Finding all shortest paths between two vertices

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.

Answer

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. According to the documentation on GraphDistance, "For a weighted graph, the distance is the minimum of the sum of weights along any path between s and t." So it should automatically work with weighted graphs.

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]

---

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]