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
  • $\begingroup$ Can you explain the problem in plain English, in addition to your code? $\endgroup$ – Szabolcs Dec 19 '17 at 16:42
  • 2
    $\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 Dec 19 '17 at 17:16
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$
1
$\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, privacy policy and cookie policy

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