# Shortest polygonal path

I'd like to find the shortest distance between some points (every point must be visited), such as between these 3 points:

 points = { {-0.9, -0.89}, {.99, .97}, {0.1, .0}}


I am sure there must be a built-in way of doing this automatically (or using Combinatorica), rather than calculating all the combinations manually. I had a quick play with:

FindShortestTour[points]


which returned:

{5.30686, {1, 2, 3}}

whereas the shortest path would be {1, 3, 2} and the Euclidean distance would be about 2, so I am clearly missing something basic ... probably related to graphs and how to set them up when the points are not on a grid??

In brief: is there an easy automated way to find the shortest distance between a set of given points?

UPDATE

Since there doesn't seem to be a built-in form, I just had a quick go at doing one manually ... I only need it for small list size $$n$$, so I'm not too worried about checking all permutations etc.

 PolygonPathMinDistance[points_] :=  Module[{orderings, pointorderings, pathsToCheck},
orderings = Union[Permutations[Range[Length[points]]],
SameTest -> (#1 == Reverse[#2] &)];
pointorderings = Map[points[[#]] &, orderings];
pathsToCheck  = Map[Partition[#, 2, 1] &, pointorderings];
Min[Map[Total[Map[EuclideanDistance @@ # &, #1]] &, pathsToCheck]]
]


Examples:

 points = {{x1, y1}, {x2, y2}, {x3, y3}};
PolygonPathMinDistance[points] points = {{x1, y1}, {x2, y2}, {x3, y3}, {x4, y4}};
PolygonPathMinDistance[points] Just comparing with the solution posted by ssch below, we have agreement for the 3 case:

points = {{-0.9, -0.89}, {.99, .97}, {0.1, .0}};
PolygonPathMinDistance[points]


2.65513

... and we have agreement for a 4 part list:

points = {{-0.9, -0.89}, {.99, .97}, {0.1, .0}, {.7, -.1}}
PolygonPathMinDistance[points]


3.05557

and ssch gets (adding magicpoint is necessary):

 mpoints = {{-0.9, -0.89}, {.99, .97}, {0.1, .0}, {.7, -.1}, magicPoint}
FindShortestTour[mpoints, DistanceFunction -> d]


{3.05557, {1, 3, 4, 2, 5}}

Cool - time for bed ... will follow up tomorrow. Many thanks! On the plus side, I am sure the ssch solution will be much faster ... but I assume it will be numeric (rather than symbolic).

• Related, but no answer – ssch Nov 17 '13 at 17:00
• There's a reason why it's called tour. It's a roundtrip, so what you get is the total distance including the trip to back the starting point. With only three points, order doesn't matter. – Sjoerd C. de Vries Nov 17 '13 at 17:23
• Combinatorica has TravelingSalesman, but that seems to do a whole tour too. – Sjoerd C. de Vries Nov 17 '13 at 17:48
• Well, I also tried FindShortestPath - but that just beeped at my input, which probably is not in graph format. I've got the Pemmaraju/Skiena Combinatorica book ... am looking at it now. – wolfies Nov 17 '13 at 17:48
• FindShortestPath needs a Graph plus start and end points. – Sjoerd C. de Vries Nov 17 '13 at 17:49

Assuming there is a Method other than "AllTours" that doesn't break if one point doesn't obey the triangle inequality, introduce a special point that has a distance 0 to all other points:

points = {{-0.9, -0.89}, {.99, .97}, {0.1, .0}, magicPoint};
d[args__] /; FreeQ[{args}, magicPoint] := EuclideanDistance[args]
d[__] = 0;
FindShortestTour[points, DistanceFunction -> d]
(* {2.65513, {1, 3, 2, 4}} *)


To know in which cases this holds one would have to know more about the different methods than I do.

Wrapping it up into usable form:

shortestPolygonPath[points_, opts : OptionsPattern[FindShortestTour]] :=
Module[{
distanceFunction =
If[# === Automatic, EuclideanDistance, #] &[OptionValue[DistanceFunction]],
magicPoint, d
},
d[args__] /; FreeQ[{args}, magicPoint] := distanceFunction[args];
d[__] = 0;
FindShortestTour[
Append[points, magicPoint],
DistanceFunction -> d,
opts
] /. {
l : {__Integer} :>
Most@RotateLeft[l, Position[l, 1 + Length@points, 1, 1][[1, 1]]]
}

]
shortestPolygonPath[{{-0.9, -0.89}, {.99, .97}, {0.1, .0}, {.7, -.1}}]
(* {3.05557, {1, 3, 4, 2}} *)