2
$\begingroup$

I have weighted, undirected full graph (generated from points in R^2), where weight between every two vertices are euclidean distance between corresponding pair of points.

What I'm trying to do is find shortest hamiltonian path in this graph - however not hamiltonian cycle.

Is there any clever way to do it in Mathematica? Or maybe not so clever, but still simple?

Edit: example

graphMatrix = {{0, 0.140892, 0.298153, 0.466667, 0.640739, 0.81446, 0.982061, 
1.13827, 1.27866, 1.4}, {0.140892, 0, 0.167897, 0.3564, 0.558216, 
0.765518, 0.970331, 1.16492, 1.3422, 1.49614}, {0.298153, 0.167897, 
0, 0.198762, 0.420358, 0.655838, 0.895711, 1.13035, 1.35045, 
1.54743}, {0.466667, 0.3564, 0.198762, 0, 0.231951, 0.487784, 
0.757188, 1.02926, 1.29299, 1.53768}, {0.640739, 0.558216, 0.420358,
0.231951, 0, 0.266598, 0.557422, 0.86095, 1.16502, 
1.45736}, {0.81446, 0.765518, 0.655838, 0.487784, 0.266598, 0, 
0.302202, 0.628537, 0.966347, 1.3023}, {0.982061, 0.970331, 
0.895711, 0.757188, 0.557422, 0.302202, 0, 0.338461, 0.70068, 
1.0729}, {1.13827, 1.16492, 1.13035, 1.02926, 0.86095, 0.628537, 
0.338461, 0, 0.375184, 0.773562}, {1.27866, 1.3422, 1.35045, 
1.29299, 1.16502, 0.966347, 0.70068, 0.375184, 0, 0.412249}, {1.4, 
1.49614, 1.54743, 1.53768, 1.45736, 1.3023, 1.0729, 0.773562, 
0.412249, 0}}
graph = Graph[WeightedAdjacencyGraph[graphMatrix], VertexLabels -> "Name"]

weighted graph

And in this case hamiltonian path would be {1, 2, 3, 4, 5, 6, 7, 8, 9, 10} (or equivalently {1 -> 2, 2 -> 3, 3 -> 4, 4 -> 5, 5 -> 6, 6 -> 7, 7 -> 8, 8 -> 9, 9 -> 10}).

HighlightGraph[graph, {1 -> 2, 2 -> 3, 3 -> 4, 4 -> 5, 5 -> 6, 6 -> 7, 7 -> 8, 8 -> 9, 9 -> 10}]

hamiltonian path in graph

$\endgroup$
  • 1
    $\begingroup$ If it is allowed to return an approximation of the shortest then you could try FindShortestTour and remove the longest leg of the tour it returns. $\endgroup$ – Daniel Lichtblau Sep 22 '14 at 22:43
  • $\begingroup$ I thought about this - and if it isn't other way I will use it. However I'm wondering if there's any better way. $\endgroup$ – Esse Sep 23 '14 at 7:28
  • $\begingroup$ Would you please add a test case and the output you would expect? $\endgroup$ – Öskå Sep 23 '14 at 9:12
  • $\begingroup$ @Öskå I've added a test case - I hope it's more clear now! $\endgroup$ – Esse Sep 23 '14 at 9:27
  • $\begingroup$ @Öskå thank you for editing - I'm new to this particular stack exchange :) $\endgroup$ – Esse Sep 23 '14 at 9:54
4
$\begingroup$

Like Daniel Lichtblau suggested, Using FindShortestTour might be the best way.

For example,

shortestPath[g_] :=
 Block[{tour, pos},
  tour = UndirectedEdge @@@ Partition[FindShortestTour[g][[2]], 2, 1];
  pos = Last[Ordering[PropertyValue[{g, #}, EdgeWeight] & /@ tour]];
  Rest[RotateLeft[tour, pos - 1]]
 ]

I replace 0 to Infinity to remove loops (doesn't really matter for computing though).

mat = graphMatrix /. {0 -> Infinity};
g = WeightedAdjacencyGraph[mat, VertexLabels -> "Name"]

enter image description here

path = shortestPath[g]

{10 <-> 9, 9 <-> 8, 8 <-> 7, 7 <-> 6, 6 <-> 5, 5 <-> 4, 4 <-> 3, 3 <-> 2, 2 <-> 1}

HighlightGraph[g, path]

enter image description here

$\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.