1
$\begingroup$

I have a such graph:

g=Graph[{1 \[DirectedEdge] 2, 2 \[DirectedEdge] 3, 4 \[DirectedEdge] 2, 
  3 \[DirectedEdge] 5, 4 \[DirectedEdge] 6, 7 \[DirectedEdge] 6, 
  4 \[DirectedEdge] 5, 8 \[DirectedEdge] 5, 8 \[DirectedEdge] 9}, 
 VertexLabels -> "Name"]

If I want to get the vertex 4's outlet by VertexOutComponent

VertexOutComponent[g, 4]

{4, 2, 6, 5, 3}

But we cannot from 4 to 3 by path $4\to2\to6\to5\to3$ obviously.Actually I want to get {{4,2,3,5},{4,5},{4,6}}.As this topological order,I name it a outlet.Or anther example frome the documentation of VertexOutComponent:

Actually the {{4,5,10},{4,9,10}} is expected result.I have a custom funtion can do this:

FindAllOutlet[g_, v_] := 
 Module[{data}, 
  data = Catenate[FindPath[g, v, #, Infinity, All] & /@ VertexList[g]];
  Select[data, 
   VertexInDegree[
      SimpleGraph[
       RelationGraph[SubsetQ, EdgeList /@ PathGraph /@ data]], 
      EdgeList[PathGraph[#]]] == 0 &]]

FindAllOutlet[g, 4]
FindAllOutlet[g2, 4]
(* {{4, 5}, {4, 2, 3, 5}, {4, 6}} *)
(* {{4, 9, 10}, {4, 5, 10}} *)

But I have to say this is a very violent and low efficience method.Cany any suggestion can give?

$\endgroup$
  • 1
    $\begingroup$ So what you want to call out-component is something else than what Mathematica calls out-component. I think nomenclature is irrelevant to the question. What's important is to explain precisely the thing you want to compute. A precise definition of your concept of "out-component" is missing. The example is useful but not sufficient. $\endgroup$ – Szabolcs Dec 9 '16 at 14:16
  • $\begingroup$ @Szabolcs I have edited it.Is there any description is not suitable still? $\endgroup$ – yode Dec 9 '16 at 15:18
5
$\begingroup$

Perhaps a slightly quicker implementation of your FindAllOutlet. I presume you wish to follow every unique path from a vertex as far as it goes.

FindAllOutlet[g_, s_] :=
 Flatten[
  FindPath[g, s, #, \[Infinity], All] & /@ 
   Flatten[Position[VertexOutDegree[g], 0]],
  1]

FindAllOutlet[g, 4]

(*{{4, 5}, {4, 2, 3, 5}, {4, 6}}*)
$\endgroup$
  • $\begingroup$ Very smart adjustment. :) $\endgroup$ – yode Dec 9 '16 at 15:47
1
$\begingroup$

This seems to be much faster than FindAllOutlet in Quantum_Oli's answer:

allPathsOut[g_, v_] :=  Module[{sink = Intersection[GraphComputation`SinkVertexList @ g, 
  VertexOutComponent[g, v]]}, Join @@ (FindPath[g, v, #, Infinity, All] & /@ sink)]

Examples:

allPathsOut[g, 4]

{{4, 5}, {4, 2, 3, 5}, {4, 6}}

HighlightGraph[g, Style[DirectedEdge @@@ Partition[#, 2, 1], Opacity[1], 
  Arrowheads[.09],Thickness[.015], RandomColor[]]& /@ allPathsOut[g, 4]]

enter image description here

allPathsOut[g2, 4]

{{4, 9, 10}, {4, 5, 10}}

HighlightGraph[g2, Style[DirectedEdge @@@ Partition[#, 2, 1], Opacity[1], 
  Arrowheads[.09],Thickness[.015], RandomColor[]]& /@ allPathsOut[g2, 4]]

enter image description here

Timings:

SeedRandom[1]
rg= RandomGraph[{10^4, 10^4}, DirectedEdges -> True];
allPathsOut[rg, 5] // RepeatedTiming // First

0.0014

FindAllOutlet[rg, 5] // RepeatedTiming // First

0.0478

allPathsOut[rg, 5] == FindAllOutlet[rg, 5]

True

SeedRandom[12345]
rg = RandomGraph[{10^4, 10^4}, DirectedEdges->True];
v = RandomChoice[VertexList[rg]];
allPathsOut[rg, v] // RepeatedTiming  // First

0.0043

FindAllOutlet[rg, v] // RepeatedTiming // First

0.0704

FindAllOutlet[rg, v] == allPathsOut[rg, v]

True

$\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.