Order items by closest to the previous

Question

I have a list of 2D points (a table, imagine the data of a parametric plot shuffled)

I would like to join the points with a line that starts from one of them and always goes to the closest one.

I tried therefore to sort the points doing the following:

take out the first element,
search the closest in the remaining list
bring it to the front
recurse

so that I can then use ListLinePlot

As a first step I tried to do it in 1D (yes, in this case a simple sorting is sufficient, but not in the 2D case)

However,I have a problem, because I do not know how to specify that a variable IS a list.

Concretely

BringToFront = 
 Function[{list, pos}, Prepend[list[[pos]], Drop[list, {pos}]]]

BringClosestToFront = 
 Fuction[{list, val}, 
  BringToFront[list, Nearest[list ->Automatic, val]]]

Follow[{}] = {};
Follow[list] = 
 Prepend[list[[1]], 
  Follow[BringClosestToFront[Drop[list, 1], list[[1]]]]]

And the BringClosestToFront is not accepted, with a

Part::partd: Part specification list[[1]] is longer than depth of object. >>

I am also worried of the speed of this recursive solution. Do you thing there may be a way to specify it in a more procedural way (i.e. implement insertion-sort)?

Prepend and Append based solution can indeed become comparatively slow... — Yves Klett, Jan 08 '13 at 09:00
An alternate style to define functions, using set delayed, is: f[x_List,pos_Integer]:=x[[pos]]. — image_doctor, Jan 08 '13 at 11:08
This is not what you asked for, but, in case it suits your final objectives better, have you checked FindShortestTour? — Rojo, Jan 08 '13 at 14:10
For some ideas you can check this previous thread or [this related MathGroup post][http://forums.wolfram.com/mathgroup/archive/2011/Mar/msg00529.html] — Daniel Lichtblau, Jan 08 '13 at 14:32

score 9 · Accepted Answer · answered Jan 08 '13 at 16:50

FindShortestTour can solve your problem. You need only choose the greedy algorithm. For example, using the same data as image_doctor:

SeedRandom[6];
data = RandomReal[{-10, 10}, {10, 2}];

FindShortestTour[data, Method -> "Greedy"]

{61.2702, {1, 7, 2, 3, 6, 4, 10, 5, 9, 8}}

Show[
  Graphics[{Line[data[[{1, 7, 2, 3, 6, 4, 10, 5, 9, 8}]]], 
     PointSize[Medium], Red, Point[data]}],
  ImageSize -> Small]

[greedy.png]

BTW, the graphics output was generated for me by V9's predictive interface. I didn't write any code for it at all.

image_doctor · Answer 2 · 2013-01-08T16:37:11.013

Here is another recursive solution based on Nest using an index to the point in the list from which to start.

order[points_List, index_Integer] :=  
Nest[With[{elem = Nearest[Last@#, Last@First@#]}, 
 {Join[First@#,elem], DeleteCases[Last@#, elem]}] &, 
 {{points[[index]]}, Drop[points, {index}]}, Length@points - 1] // First

It looks more complicated than it actually is ( I know that a more concise implementation is out there ). It begins with a list of the form, {{start point},{other points}}. Then moves the nearest point from other points onto the end of the start point list. It continues using the last element of the extended list to find the nearest element in the list of remaining points.

Using BG's data:

ListLinePlot@order[data, 1]

ListLinePlot@order[data, 5]

As a guide to speed, 10 thousand elements took around 44 seconds:

SeedRandom[6];
data2 = RandomReal[{-10, 10}, {10^4, 2}];

Timing[order[data2, 1];]

{43.8883, Null}

A less readable version which maintains duplicate points and is around 20+% faster is as follows:

order[points_, index_] := 
 Nest[With[{p = 
       First@Position[Last@#, 
         First@Nearest[Last@#, Last@First@#]]}, {Join[First@#, 
       Take[Last@#, p]], Drop[Last@#, p]}] &, {{points[[index]]}, 
    Drop[points, {index}]}, Length@points - 1] // First

You have used Length[l] in your code, but l is undefined. I assume this should be Length[points], which may affect the speed estimate. — Simon Woods, Jan 08 '13 at 13:07
@SimonWoods Thanks for that, a cut and paste job that went badly wrong. — image_doctor, Jan 08 '13 at 15:29
Thank you, I learned a lot of syntax I didn't know from your code! — Fabio Dalla Libera, Jan 16 '13 at 01:49
@FabioDallaLibera that's very kind of you to say. Good luck. — image_doctor, Jan 16 '13 at 08:37

score 6 · Answer 3 · answered Jan 08 '13 at 08:55

6

One simple way :

SeedRandom[6];
data = RandomReal[{-10, 10}, {10, 2}] ;

findNearest[list_, point_] := SortBy[list, EuclideanDistance[#, point] &][[1]]

copy = data;
output = NestList[findNearest[copy = DeleteCases[copy, #], #] &, copy[[1]], Length[copy] - 1];

GraphicsColumn[{ListLinePlot[data], ListLinePlot[output]}]

enter image description here

answered Jan 08 '13 at 08:55

b.gates.you.know.what

20,103
2
43
84

Thank you, the NestList as a for loop, and the self assignment (overwrite) inside the function argument are very interesting! – Fabio Dalla Libera Jan 08 '13 at 09:07
ok,then I temporarily disable and tick it again later – Fabio Dalla Libera Jan 08 '13 at 09:09

score 3 · Answer 4 · answered Jan 08 '13 at 13:16

3

Here's a version based on a recursively defined function f:

f[{x_, y_}] := f[{x~Join~y[[#]], Drop[y, #]} &@Nearest[y -> Automatic, Last@x]];
f[{x_, {}}] := x;

data = RandomReal[{-10, 10}, {1000, 2}];
output = f[{{First[data]}, Rest[data]}];
ListLinePlot[output, Mesh -> True]

enter image description here

answered Jan 08 '13 at 13:16

Simon Woods

84,945
8
175
324

Thank you for your compact solution! – Fabio Dalla Libera Jan 16 '13 at 01:50
This seems to produce the same output as FindShortestTour for the given example and it's faster. – Mr.Wizard Jul 18 '14 at 06:24

Order items by closest to the previous

4 Answers4