6

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).

Glorfindel
  • 547
  • 1
  • 8
  • 14
wolfies
  • 8,722
  • 1
  • 25
  • 54
  • 2
    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
  • @wolfies If I understood you correctly, you want a tour (i.e. visit all points), where the final "distance" to be minimized is defined as the Euclidean distance between the start and end points, correct? – rm -rf Nov 17 '13 at 17:50
  • @rm-rf Visit all points once ... but do not return to base. So, apparently, not a tour but the shortest path. As if you joined all the points with a line ... and wanted the shortest possible line (polygon path), measured as Euclidean distance. – wolfies Nov 17 '13 at 17:52
  • @rm-rf That doesn't seem to make sense to me.The sum of a row or column is the sum of all distances from one given point to all others. BTW FindShortestPath skips points because its task is simply not to visit all points, but find the shortest route between two points. – Sjoerd C. de Vries Nov 17 '13 at 18:43
  • @SjoerdC.deVries Ugh... my bad. That was complete garbage. – rm -rf Nov 17 '13 at 19:21
  • @rm-rf well, I am grateful -- I nicked the EuclideanDistance func from your comment :) – wolfies Nov 17 '13 at 19:29
  • Use FindShortestTour and delete the longest distance between any pair of adjacent points in the tour? – Daniel Lichtblau Nov 17 '13 at 19:44

1 Answers1

6

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}} *)
ssch
  • 16,590
  • 2
  • 53
  • 88