17
$\begingroup$

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, ...}. ?

$\endgroup$
1
  • $\begingroup$ Have a look at ref/ConnectedComponents. I think the form ConnectedComponents[graph,{vertex}] might be what you want. $\endgroup$ Apr 27, 2012 at 22:10

4 Answers 4

18
$\begingroup$

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[].

$\endgroup$
15
$\begingroup$

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.


Calculation and return of all connections as an Association:

allConnected[edges_] :=
  Module[{a = <||>, f},
    f[x_] := (a[x] = {}; a[x] = # ⋃ Flatten[f /@ #] & @ ReplaceList[x, edges]);
    f ~Scan~ Union @ Keys[edges];
    KeySort @ a
  ]

allConnected[edges]
<|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 -> {}|>
allConnected[edges] ~Lookup~ {6, 4}
{{7, 8, 9, 10}, {9, 10}}
$\endgroup$
4
  • $\begingroup$ +1. But note that your solution goes into an infinite loop, when processing loops in a graph. $\endgroup$ Apr 27, 2012 at 22:53
  • $\begingroup$ @Leonid oops. Did I fix it? $\endgroup$
    – Mr.Wizard
    Apr 28, 2012 at 8:01
  • $\begingroup$ Looks like you did. Very elegant solution. It deserves more upvotes, in my view. $\endgroup$ Apr 28, 2012 at 20:55
  • $\begingroup$ @Leonid thanks. $\endgroup$
    – Mr.Wizard
    Apr 29, 2012 at 13:30
4
$\begingroup$

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].

$\endgroup$
0
1
$\begingroup$

Yet another way using GraphDistanceMatrix:

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};

If

mygraph = Graph@edges;
vertex = VertexList@mygraph;
graphdist = GraphDistanceMatrix@mygraph;

then

{vertex, Pick[##, Except[_List | Infinity | 0]] & @@@ 
     Thread[{vertex, graphdist}, List, {2}]} // Transpose // Sort // Column

returns

{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,{}}
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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