# Tracing 2d coordinates by using Nearest function

In 5 digital images I have determined the 2d coordinates of detected objects. The resulting coordinate list can be downloaded from here: http://pastebin.com/7bE0CEJ5

list= {{{1, {533.286, 574.643}}, ... , {443, {371., 3.5}}}}


whereby

Dimensions /@ list gives

{{443, 2}, {443, 2}, {444, 2}, {442, 2}, {443, 2}}


A color coded plot of the coordinates in all 5 images is shown here: colors = {Blue, Green, Yellow, Orange, Red}


The colors correspond to the image sequence.

Since only red points are seen, it shows that the displacement of the objects is very small.

A selection where only one particle trace is seen is: This shows how an object randomly vibrates.

The number of detected objects per image is varying (443 -> 443 -> 444 -> 442 -> 443), because new objects can appear in an image (not detected in the image before) or/and objects detected in an image can disappear in the next one.

Now I want to trace the (same) objects (their coordinates) in the 5 images by using the Nearest function. The objects are moving only slightly from image to image (much less than than half of their mean distance), therefore Nearest is appropriate.

The coordinates of the objects in the 5 images are:

coordinates1 = list[][[All, 2]];
coordinates2 = list[][[All, 2]]
coordinates3 = list[][[All, 2]]
coordinates4 = list[][[All, 2]]
coordinates5 = list[][[All, 2]]


To find the Nearest neighbors to object 1 in coordinates1 I can write:

c1 = coordinates1[];
c2 = Nearest[coordinates2, c1][];
c3 = Nearest[coordinates3, c2][];
c4 = Nearest[coordinates4, c3][];
c5 = Nearest[coordinates5, c4][];


Combined in a trace-list for object 1 this yields:

{c1,c2,c3,c4,c5} =

{{533.286, 574.643}, {533.667, 574.667}, {533.115, 574.654}, {533.167, 574.633}, {533.115, 574.654}}

For object 440 this gives:

c1 = coordinates1];
c2 = Nearest[coordinates2, c1][];
c3 = Nearest[coordinates3, c2][];
c4 = Nearest[coordinates4, c3][];
c5 = Nearest[coordinates5, c4][];


Combined in a trace-list for object 440 this yields:

{c1,c2,c3,c4,c5} =

{{190.5, 3.5}, {192., 3.5}, {191.5, 3.5}, {187.975, 17.775}, {188.23, 18.1216}}

To improve this elements-wise calculation, Nearest can also be called with two lists:

Nearest[coordinates2 , coordinates1]


This gives the nearest neighbors in coordinates2 relativ to coordinates1:

{{{533.667, 574.667}}... , {{373., 3.5}}}


This gives the following code:

n1 = coordinates1;
n2 = Nearest[coordinates2, coordinates1];
n3 = Nearest[coordinates3, coordinates2];
n4 = Nearest[coordinates4, coordinates3];
n5 = Nearest[coordinates5, coordinates4];


From that I can get accidentally all traces for object 1 (as shown above):

{{n1[], n2[], n3[], n4[], n5[]} =

{{533.286, 574.643}, {{533.667, 574.667}}, {{533.115, 574.654}}, {{533.167, 574.633}}, {{533.115, 574.654}}}

But it is wrong e.g for number 440 (see correct trace results above):

{n1[], n2[], n3[], n4[], n5[]} =

{{190.5, 3.5}, {{192., 3.5}}, {{11.75, 3.25}}, {{487.958, 6.33333}}, {{489.154, 6.19231}}}

How can I obtain the correct traces for all coordinates in the 5 images?

To call Nearest with two lists is probably fastest. But the problem here is that I have to find out how to assign the correct indices of n1 to n5to represent the same object.

If l is your list:

l1 = l[[All, All, 2]];
g = Nearest[l1[[#]] -> Automatic] & /@ Range@Length@l1;
corr[i_] := MapIndexed[{g[[i]][#1, {1, 7}], #2} &, l1[[i + 1]]]
ls = Fold[#1 /. {s___, {x_}} :> {s, {x}, Cases[#2, {{x}, _}][[1, 2]]} &, corr /@ Range@4]


I'm using V9 syntax above, it can probably be shorter if you use V10's

Let's Animate the displacements:

ls1 = Cases[Flatten /@ ls, {_Integer, Integer_, Integer_, Integer_, Integer_}];
ls2 = ls1 /. {a_Integer, b_Integer, c_Integer, d_Integer, e_Integer} :>
Quiet@Evaluate[l1[[##]] & @@@ Thread[{Range@5, {a, b, c, d, e}}]];
ls3 = Partition[#, 2, 1] & /@ ls2;
ls4 = ls3 /. {{a_, b_}, {c_, d_}} :> {{a, b}, {c, d} - {a, b}};
ListAnimate[ ListVectorPlot[#, PlotRange -> {{-100, 900}, {0, 700}}] & /@ Transpose@ls4] • The 7 is empirical – Dr. belisarius Dec 16 '15 at 15:59
• incredibly ... I have to check this tomorrow – mrz Dec 16 '15 at 18:14
• This problem for wrong coordinate assignment could be solved by considering that only nearest coordinates should be tracked that are below a certain radius. How could that be integrated? The coordinates that belong to a trace are much less than (half of) the mean object spacing. – mrz Jun 26 '16 at 18:12
c = Map[Last, list, {2}];

res =
Rest@FoldList[First@Nearest[c[[#2]], #1] &, c[[1, #]], Range@Length@c] & /@
Range@Length@First@c; // AbsoluteTiming // First

0.160000


And now simply

res[]


{{533.286, 574.643}, {533.667, 574.667}, {533.115, 574.654}, {533.167, 574.633}, {533.115, 574.654}}

or

res[]


{{190.5, 3.5}, {192., 3.5}, {191.5, 3.5}, {187.975, 17.775}, {188.23, 18.1216}}

• Not sure ... res[] and res[] (for example) both end with the same "particle" – Dr. belisarius Dec 16 '15 at 16:50
• I'm not sure either. I just thought that FoldList (instead of all those variable names) might facilitate the calculations of the OP . Also, my results for 1 and 440` are equal to his results. – eldo Dec 16 '15 at 17:13
• This problem could be solved by considering that only nearest coordinates should be tracked that are below a certain radius. How could that be integrated? The coordinates that belong to a trace are much less than (half of) the mean object spacing. – mrz Jun 26 '16 at 18:11