8
$\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$
  • $\begingroup$ I encountered a similar problem in Google foobar challenge. And in the end I was using the brute force way. $\endgroup$ – xslittlegrass Feb 4 '17 at 22:13
12
$\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$
  • $\begingroup$ Thanks very much.I'd like to know that non-force method still. :) $\endgroup$ – yode Jan 26 '17 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. Jan 26 '17 at 17:01
  • $\begingroup$ I'm sorry,that is a typo.I have adjusted that. $\endgroup$ – yode Jan 26 '17 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. Jan 26 '17 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$ – David G. Stork Jan 26 '17 at 17:30
4
$\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$
  • $\begingroup$ All path you find just contain eight vertices?Acrually the longest path contain nine vertices as I know. $\endgroup$ – yode Jan 27 '17 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$ – Semiclassical Aug 1 '17 at 1:24

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.