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.

How to find all vertices reachable from a given start vertex following directed edges, in a cyclic directed graph given as

Graph[{v1, v2, ...}, 
      {v1 -> v11, v1 -> v12, ..., v2 -> v21, v2 -> v21, ..., vn -> vn1, vn -> vn2, ...}]

where all the ending vertices of edges vij are in the list of vertices {v1, v2, ...}. ?

share|improve this question
    
Have a look at ref/ConnectedComponents. I think the form ConnectedComponents[graph,{vertex}] might be what you want. –  Daniel Lichtblau Apr 27 '12 at 22:10
add comment

3 Answers 3

up vote 15 down vote accepted

One can use VertexOutComponent[] to find all the vertices connected to a given vertex in a directed graph:

In[107]:= edges={1->3,1->4,2->4,2->5,3->5,6->7,7->8,8->9,9->10,6->10,1->6,2->7,3->8,4->9,5->10};
In[114]:= vertices=Sort@DeleteDuplicates[Flatten[List@@@edges]];
In[115]:= g=Graph[vertices,edges];
In[116]:= {#,VertexOutComponent[g,{#}]}&/@vertices//Grid
Out[116]= 1 {1,3,4,5,6,7,8,9,10}
2   {2,4,5,7,8,9,10}
3   {3,5,8,9,10}
4   {4,9,10}
5   {5,10}
6   {6,7,8,9,10}
7   {7,8,9,10}
8   {8,9,10}
9   {9,10}
10  {10}

It should work for any directed graph whether it's acyclic or not. The analogue of VertexOutComponent[] for undirected graphs is ConnectedComponents[].

share|improve this answer
add comment

Perhaps something like this?

edges = {1 -> 3, 1 -> 4, 2 -> 4, 2 -> 5, 3 -> 5, 6 -> 7, 7 -> 8, 
   8 -> 9, 9 -> 10, 6 -> 10, 1 -> 6, 2 -> 7, 3 -> 8, 4 -> 9, 5 -> 10};

GraphPlot[edges, DirectedEdges -> True, VertexLabeling -> True]

Mathematica graphics

connected[edges_][v_] :=
  Module[{f},
    f[x_] := (f[x] = {}; f[x] = # ⋃ Flatten[f /@ #]& @ ReplaceList[x, edges]);
    f[v]
  ]

connected[edges][2]
{4, 5, 7, 8, 9, 10}

On large graphs it will be advantageous to convert the edges to a Dispatch table.

share|improve this answer
    
+1. But note that your solution goes into an infinite loop, when processing loops in a graph. –  Leonid Shifrin Apr 27 '12 at 22:53
    
@Leonid oops. Did I fix it? –  Mr.Wizard Apr 28 '12 at 8:01
    
Looks like you did. Very elegant solution. It deserves more upvotes, in my view. –  Leonid Shifrin Apr 28 '12 at 20:55
    
@Leonid thanks. –  Mr.Wizard Apr 29 '12 at 13:30
add comment

Adapting this answer for finding the transitive closure of a symmetric binary relation (and dropping the symmetry property):

 edges = {1 -> 3, 1 -> 4, 2 -> 4, 2 -> 5, 3 -> 5, 6 -> 7, 7 -> 8, 
 8 -> 9, 9 -> 10, 6 -> 10, 1 -> 6, 2 -> 7, 3 -> 8, 4 -> 9, 5 -> 10};  

 pairs = edges /. Rule -> List;
 m = Max@pairs;
 (*the adjacency matrix of atomic elements in pairs:*)
 SparseArray[pairs~Append~{i_, i_} -> 1, {m, m}];
 (* find the transitive closure:*)
 Normal@Sign@MatrixPower[N@%, m];
 (* find labels of reachable vertices  *)
 Join @@ Position[#, 1] & /@ %
 (*==> {{1, 3, 4, 5, 6, 7, 8, 9, 10}, {2, 4, 5, 7, 8, 9, 10}, 
  {3, 5, 8, 9, 10}, {4, 9, 10}, {5, 10}, {6, 7, 8, 9, 10}, 
  {7, 8, 9, 10}, {8, 9, 10}, {9, 10}, {10}}  *)
 (* organize: *)
 Grid[{First@#, Rest@#} & /@ %, Alignment -> Left]

enter image description here

Note: As is, this works for cases where the vertex list is a range of contigous integers. For a general graph g where vertex list is an arbitrary set, one can work with the set of vertex indices VertexIndex[g,#]&/@VertexList[g].

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.