3
$\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$
7
  • 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$ Sep 22, 2014 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, 2014 at 7:28
  • $\begingroup$ Would you please add a test case and the output you would expect? $\endgroup$
    – Öskå
    Sep 23, 2014 at 9:12
  • $\begingroup$ @Öskå I've added a test case - I hope it's more clear now! $\endgroup$
    – Esse
    Sep 23, 2014 at 9:27
  • $\begingroup$ @Öskå thank you for editing - I'm new to this particular stack exchange :) $\endgroup$
    – Esse
    Sep 23, 2014 at 9:54

2 Answers 2

5
$\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$
0
2
$\begingroup$

In versions 10.2+, you can use FindHamiltonianPath:

  • "HamiltonianPath[g] finds a Hamiltonian path in the graph g with the smallest total length."

hpath = FindHamiltonianPath[graph]
{10, 9, 8, 7, 6, 5, 4, 3, 2, 1}
HighlightGraph[graph, PathGraph @ hpath, GraphHighlightStyle -> "Thick"]

enter image description here

$\endgroup$

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.