3
$\begingroup$

Given an acyclic directed graph, say with

edges = {{1, 12}, {2, 3}, {3, 1}, {4, 5}, {7, 5}, {8, 10}, {9, 10}, {10, 11}};

the maximal paths (if that is the right term) can be found as

With[{pathfinder = FindShortestPath[DirectedEdge @@@ edges],
       subgraphs = ConnectedComponents[UndirectedEdge @@@ edges],
          begins = Complement[edges[[All, 1]], edges[[All, 2]]],
            ends = Complement[edges[[All, 2]], edges[[All, 1]]]},

  pathfinder @@@ Join @@ (Tuples[{begins ⋂ #, ends ⋂ #}] & /@ subgraphs)]

Out[]= {{2, 3, 1, 12}, {4, 5}, {7, 5}, {8, 10, 11}, {9, 10, 11}}

How to do this with graph functions so as to reduce the complexity?

$\endgroup$
2
  • 1
    $\begingroup$ Can you explain the problem in plain English, in addition to your code? $\endgroup$
    – Szabolcs
    Commented Dec 19, 2017 at 16:42
  • 3
    $\begingroup$ You can find the source and sink vertices using Pick[VertexList[g], VertexOutDegree[g], 0] and Pick[VertexList[g], VertexInDegree[g], 0] if g is a directed graph. $\endgroup$
    – Szabolcs
    Commented Dec 19, 2017 at 17:16

2 Answers 2

2
$\begingroup$
ClearAll[sstsp, shortestSourceToSinkPaths, highlightPaths]
sstsp = shortestSourceToSinkPaths = Module[{g = #, 
   sources = GraphComputation`SourceVertexList @ #, 
   sinks = GraphComputation`SinkVertexList @ #}, 
 Join @@ (Module[{v = #, vsinks = Intersection[sinks, VertexOutComponent[g, #]]}, 
   Join @@ (MinimalBy[Length][FindPath[g, v, #, Infinity, All] ]& /@ sinks)]&/@sources)]&;

highlightPaths = Module[{g = #}, 
   HighlightGraph[g, Style[Subgraph[g, #], Thick] & /@ sstsp[g],
    PlotLabel -> Style[sstsp[g], Black, 12, "Panel", Background -> None]]]&;

Examples:

edges = {{1, 12}, {2, 3}, {3, 1}, {4, 5}, {7, 5}, {8, 10}, {9, 10}, {10, 11}};
g = Graph[DirectedEdge @@@ edges, VertexShapeFunction->"Name"];

highlightPaths @ g

enter image description here

SeedRandom[123]
g2 =  RandomGraph[PriceGraphDistribution[10, 3, 2], 
  DirectedEdges -> True, VertexShapeFunction-> "Name", ImageSize->600];

highlightPaths @ g2 

enter image description here

$\endgroup$
2
$\begingroup$

I'm assuming by "maximal" path you mean the maximum-length shortest path between two vertexes. (If not, you can always make a longer path by wandering around the graph... unhelpful.)

g = Graph[edges];
First@GroupBy[
  Flatten[
    Table[{i, j, Length@FindShortestPath[g, i, j]}, 
      {i, Length[edges]}, {j, i - 1}], 1], #[[3]] &]

(* {{2,1,3}, {7, 4, 3}} *)

which means that the longest path is of length 3 and is between vertexes 2 an 1 and between vertexes 7 and 4.

This function is extremely fast, finding the longest paths in g = RandomGraph[{20000, 40000}]; in $0.014693$ seconds.

Try:

g = RandomGraph[{20000, 40000}];
Timing[First@
  GroupBy[Flatten[
    Table[{i, j, Length@FindShortestPath[g, i, j]}, 
      {i, Length[edges]}, {j, i - 1}], 1], #[[3]] &]]
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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