Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

There are built-in methods to find a shortest path between two vertices in a graph, and the question on finding all shortest paths between two vertices has gathered quite a bit of attention.

A path is simple if it repeats no vertices. As is with all shortest paths between a pair of vertices, the number of simple paths between two vertices can be huge. What would be a nice and clean method of finding all simple paths between two vertices?

Assume the input graph is undirected, simple, and it may have cycles in it. I am not interested in the number of simple paths between $s$ and $t$, but I want to explicitly enumerate all of them. Furthermore, note that this problem cannot be solved in polynomial time. Even writing the output might take time that is not polynomial in the number of vertices.

One way of listing the simple paths is to use depth-first search. Maybe DepthFirstScan is useful here. The DFS can avoid repeating vertices by marking them as they are visited in the recursion, and then removing the mark just before returning from the recursive call. I learned a backtracking solution might not be that fast.

share|improve this question
    
As an add on to your write up other than DFS and BFS you can also use Bee Colony optimization algorithms which works great specially when you have some nodes with higher preference than other other nodes with less. –  Rorschach May 24 '13 at 5:25
    
actually I worked on it as part of my college assignment[coded in java] and it gives very sound results. It's very effective specially if preference is priority as in case of BFS,DFS all paths have to be traversed but in it, this is not compulsion, so it's less time consuming with best output. –  Rorschach May 24 '13 at 5:32
    
Preference might not be important in your work now but as example, if you want to route traffic through least congested node than even if length traversed is more, its the best to go to..with BC we can easily find it. –  Rorschach May 24 '13 at 5:36
    
Since finding all simple paths is definitely not the bottleneck of my application, I implemented a randomized DFS that finds some $s$-$t$ path in the graph $G$. Calling the method sufficiently many times guarantees all paths will be found with high probability. This does not answer the question, which is asking for a deterministic enumeration algorithm. I hope someone with more Mathematica knowledge could solve this even rather easily. –  mrm May 28 '13 at 19:27
    
If I am not wrong solution to your question is very close to approach followed for finding subgroups of a group in group theory which is strangely a hard problem and is achieved by using randomized data as input to satisfy some parameters. After repeated check finally the most optimum are selected and they are the subgroups.No algorithm till this date exists to find subgroups in efficient way. –  Rorschach May 29 '13 at 12:17

4 Answers 4

Disclaimer: OP problem is more specific than the problem solved here. This solution has been posted primarily to draw some attention and to give some ideas. For a possibly more efficient solution of OP problem I would suggest looking into algorithms searching for strongly connected components (e.g. Tarjan's algorithm).

All simple paths in a (directed) graph

Below is an explicit implementation from this paper. Claimed to perform $\mathcal{O}(n^3)$ operations - whatever it means, i.e. I think there is ca. $\sum_{k=2}^n \binom{n}{k} \frac{k!}{2} = \Omega(2^n)$ simple paths to generate in a $n$-clique. Nevertheless, this algorithm looks interesting e.g. for its bit descriptors. There is plenty of room for improvement, including not Mathematica specific improvements (e.g. Section IV remarks on efficient implementation are not implemented).

The algorithm w/ auxiliary functions:

pairs[l1_, l2_] := Transpose[{l1, l2}]
initializePathDescriptorMatrix[g_] := Module[{a, e, m, n},
  a = Normal[System`AdjacencyMatrix[g]];
  e = Position[a, 1];
  (* e == Sort[(EdgeList[g] /. Rule@@@pairs[System`VertexList[g], Range[n]]) /. DirectedEdge -> List] *)
  m = Length[e];
  n = Length[a];
  (a[[#1[[1]], #1[[2]]]] = {{Plus @@ (2^(n - #) & /@ #1), 2^(m - #2)}}) & @@@
    pairs[e,Range[m]];
  a = a /. {0 -> {}};
  a
  ]
generatePathDescriptorMatrix[g_] := Module[{dm, n, j, k, i},
  dm = initializePathDescriptorMatrix[g];
  n = Length[dm]; (* VertexCount[g] *)      
  For[j = 1, j <= n, j++,
   For[i = 1, i <= n, i++,
    For[k = 1, k <= n, k++,
     Function[{v, e},
       Function[{w, f},
         If[BitAnd[v, w] == 2^(n - j),
          dm[[i, k]] = Append[dm[[i, k]], BitOr @@@ {{v, w}, {e, f}}]
         ]
       ] @@@ dm[[j, k]]
     ] @@@ dm[[i, j]]
  ]]];      
  dm
]

And examples w/ some more auxiliary functions:

descriptorToEdgePath[g_, {}] := {}
descriptorToEdgePath[g_, d_] := Part[(* w/ crude solution for edges/vectices reordering *)
   Sort[System`EdgeList[g] /. (Rule @@@ pairs[System`VertexList[g], Range[System`VertexCount[g]]])],
   Flatten[Position[IntegerDigits[d[[2]], 2, System`EdgeCount[g]], 1]]
 ] /. (Rule @@@ pairs[Range[System`VertexCount[g]], System`VertexList[g]])
partg[g_] := Function[{m, v, w}, m[[ VertexIndex[g, v], VertexIndex[g, w]] ]]

(* paper example graph w/ 3 paths from 1 to 5 *)
e = {1 -> 2, 1 -> 3, 1 -> 4, 2 -> 4, 2 -> 5, 4 -> 5} ;
g = System`Graph[e, VertexLabels -> "Name"];
dm = generatePathDescriptorMatrix[g];
(* paths from 1 to 5 *)
(* Note: paths are sorted by vertex (in VertexList order), length, vertex etc. key  *)
descriptorToEdgePath[g, #] & /@ partg[g][dm, 1, 5];
GraphicsRow[HighlightGraph[g, #] & /@ %, ImageSize -> 600]

Ex1: all simple paths from vertex 1 to 5

(* cycle example *)
e = {x -> y, y -> z, z -> x, y -> v};
g = System`Graph[e, VertexLabels -> "Name"];
dm = generatePathDescriptorMatrix[g];
Length[Flatten[dm, 2]] == 9
(* 1 path of length 3 (z -> v) + 4 paths of length 2 (3 within cycle) + 4 edges  *)
(* paths of length 2 *)
descriptorToEdgePath[g, #] & /@
  Cases[Flatten[dm, 2], {_, ed_} /; Length[Position[IntegerDigits[ed, 2], 1]] == 2];
GraphicsGrid[Partition[HighlightGraph[g, #] & /@ %, 2], ImageSize -> 600]

Ex2: all simple paths of length 2

share|improve this answer
    
It's not an answer in a sense that it solves a more general problem, so probably it is not really clean. Moreover, a natural guess is that solving this problem for two fixed vertices should give a solution which is more efficient. At least in practice because again for an (undirected) $n$-clique we have ca. $\sum_{k=1}^{n-2} \binom{n-2}{k} k! = \Omega(2^n)$ simple paths between two fixed vertices. Regarding the paper: if you're interested and can't get it then mail me (cf. my website); I will send you PDF. –  trybik May 29 '13 at 19:59
    
It is at least cleaner than what I had. It works well enough for me, since my graphs are small and finding all simple paths is not the bottleneck anyway. For the paper, I should be able to access it from my office so you don't need to bother. Thanks again! –  mrm May 29 '13 at 20:06

For directed graphs (cyclic or acyclic), here is a simple method that recursively scans the neighbours of a source vertex s until it finds all paths to a target vertex t (either using the graph or its adjacency matrix):

findPaths[a_?MatrixQ, s_Integer, t_Integer] := Module[{child, find},
   child[v_] := Flatten@Position[a[[v]], Except@0, 1, Heads -> False];
   find[v_, list_] := Scan[If[# === t, Sow[Append[list, #]], 
            If[FreeQ[list, #], find[#, Append[list, #]]]] &, child@v];
   If[# =!= {}, First@#, {}]&@Last@Reap@find[s, {s}]
   ];
findPaths[g_Graph, s_, t_] := Module[{nodes = VertexList@g, convert},
   convert = Thread[nodes -> Range@Length@nodes];
   findPaths[Normal@AdjacencyMatrix@g, s /. convert, t /. convert] /. Reverse/@convert
   ];

Test it for a random directed graph:

edges = {2 -> 1, 1 -> 3, 1 -> 4, 5 -> 1, 8 -> 1, 2 -> 6, 2 -> 10,
         4 -> 3, 3 -> 7, 4 -> 9, 6 -> 5, 5 -> 7, 9 -> 5, 7 -> 6, 6 -> 9};
g = Graph[edges, VertexLabels -> "Name"];
paths = findPaths[g, 5, 9]
HighlightGraph[g, Rule @@@ Partition[#, 2, 1], PlotLabel -> #] & /@ paths
{{5, 1, 3, 7, 6, 9}, {5, 1, 4, 3, 7, 6, 9}, {5, 1, 4, 9}, {5, 7, 6, 9}}

Mathematica graphics

For a use case, see this thread.

share|improve this answer
    
+1 Very nice. I used your code here mathematica.stackexchange.com/a/43429/193. Hope you don't mind :) –  belisarius Mar 5 at 6:24
    
@belisarius Sure, it's always good to see that what we do in SE is sometimes useful for others and put to the test! Thanks for the credit. –  István Zachar Mar 5 at 9:55

Here's a little wrapper for the code posted by @trybik. The function abstract away the conversion to an directed graph and back.

FindAllPaths[g_, s_, t_] :=
Module[{copy = DirectedGraph[g]},
dm = generatePathDescriptorMatrix[copy];
Return [Apply[UndirectedEdge,
 descriptorToEdgePath[copy, #] & /@ partg[copy][dm, s, t], {2}]];
];

Usage:

g = Graph[{1 \[UndirectedEdge] 3, 1 \[UndirectedEdge] 4, 
3 \[UndirectedEdge] 5, 3 \[UndirectedEdge] 4, 
4 \[UndirectedEdge] 5, 5 \[UndirectedEdge] 2}, 
VertexLabels -> "Name", ImagePadding -> 20]
FindAllPaths[g, 2, 1];
HighlightGraph[g, #] & /@ %
share|improve this answer
up vote 3 down vote accepted

You can use the new FindPath function that comes with Mathematica 10. A simple example:

g = CompleteGraph[4];
FindPath[g, 1, 2, Infinity, All]

(* Output: {{1,2},{1,4,2},{1,3,2},{1,4,3,2},{1,3,4,2}} *)

The function also accepts parameters, so you can find a path (or all paths) of specific length. See the docs for more.

share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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