# Finding Hamiltonian path in Graph

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"]


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}]


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

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"]


path = shortestPath[g]


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

HighlightGraph[g, path]


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"]