# How to find a longest path, which contains as many vertices

I have this graph:

g=Graph[{1, 2, 3, 4, 5, 6, 7, 8, 9,
10}, {SparseArray[Automatic, {10, 10},
0, {1, {{0, 2, 5, 7, 9, 11, 13, 15, 16, 18,
20}, {{3}, {4}, {1}, {6}, {8}, {5}, {9}, {2}, {9}, {2}, {6},
{3}, {5}, {7}, {8}, {4},
{1}, {8}, {1}, {3}}}, {1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1}}], Null}, {VertexLabels -> {"Name"}}]


I want to find a longest path, which contains as many vertices as this path $7\to8\to4\to9\to1\to3\to5\to2\to6$ found by visual inspection. But how do I find it with Mathematica?

• I encountered a similar problem in Google foobar challenge. And in the end I was using the brute force way. – xslittlegrass Feb 4 '17 at 22:13

You can just find all the paths by brute force, and use MaximalBy

allPaths =
FindPath[g, #2, #1, Infinity, All] & @@@
Subsets[VertexList[g], {2}] // Apply[Join];
MaximalBy[allPaths, Length@Union@# &]
(* {{10, 1, 3, 9, 8, 4, 2, 6, 5}, {7, 8, 4, 9, 1, 3, 5, 2, 6}} *)

• Thanks very much.I'd like to know that non-force method still. :) – yode Jan 26 '17 at 16:59
• I'm still curious if I interpret your question correctly. The target you give has a loop at vertex 2. – Jason B. Jan 26 '17 at 17:01
• I'm sorry,that is a typo.I have adjusted that. – yode Jan 26 '17 at 17:07
• From what I read here, it's a hard problem. There is apparently a neat solution for acyclic graphs, but that doesn't apply here. – Jason B. Jan 26 '17 at 17:17
• I would prune the search in a graph of $n$ vertexes by first seeking paths of length $n$, then $n-1$, then $n-2$... Do this by starting with the unique vertex set containing $n$ vertexes, then the $n$ vertex sets containing $n-1$ vertexes, then the ${n \choose 2}$ sets containing $n-2$ vertexes, and so on. – David G. Stork Jan 26 '17 at 17:30

The pruned approach, in which long lists of vertices are tried first and the process terminated once such a path is found:

endptlist = Subsets[Range[10], {2}];
Catch[
Do[
If[(currentlist = DeleteCases[(FindPath[g, #1, #2, {i}] & @@@
endptlist), {}]) != {},
Throw[currentlist]],
{i, 10, 1, -1}]]


(* {{{1, 3, 9, 8, 4, 2, 6, 5}}, {{2, 8, 4, 9, 1, 3, 5, 6}}, {{5, 6, 3, 9, 1, 4, 2, 8}}, {{6, 3, 5, 2, 1, 4, 9, 8}}} *)

• All path you find just contain eight vertices?Acrually the longest path contain nine vertices as I know. – yode Jan 27 '17 at 7:17
• Is there a resolution to why the above algorithm doesn't reproduce the length-9 path in the other answer? – Semiclassical Aug 1 '17 at 1:24