18

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

Sjoerd C. de Vries
  • 65,815
  • 14
  • 188
  • 323
user13253
  • 8,666
  • 2
  • 42
  • 65

4 Answers4

19

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

user13253
  • 8,666
  • 2
  • 42
  • 65
Meng Lu
  • 446
  • 2
  • 3
16

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}}
Mr.Wizard
  • 271,378
  • 34
  • 587
  • 1,371
4

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

kglr
  • 394,356
  • 18
  • 477
  • 896
2

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,{}}
SquareOne
  • 7,575
  • 1
  • 15
  • 34