11
$\begingroup$

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?

$\endgroup$
1
  • $\begingroup$ I encountered a similar problem in Google foobar challenge. And in the end I was using the brute force way. $\endgroup$ Commented Feb 4, 2017 at 22:13

2 Answers 2

15
$\begingroup$

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}} *)
$\endgroup$
7
  • $\begingroup$ Thanks very much.I'd like to know that non-force method still. :) $\endgroup$
    – yode
    Commented Jan 26, 2017 at 16:59
  • 1
    $\begingroup$ I'm still curious if I interpret your question correctly. The target you give has a loop at vertex 2. $\endgroup$
    – Jason B.
    Commented Jan 26, 2017 at 17:01
  • $\begingroup$ I'm sorry,that is a typo.I have adjusted that. $\endgroup$
    – yode
    Commented Jan 26, 2017 at 17:07
  • 1
    $\begingroup$ 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. $\endgroup$
    – Jason B.
    Commented Jan 26, 2017 at 17:17
  • $\begingroup$ 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. $\endgroup$ Commented Jan 26, 2017 at 17:30
5
$\begingroup$

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}}} *)

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

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.