5
$\begingroup$

I have as an example the following 2d-coordinates:

list={{533.286, 574.643}, {13.4032, 571.984}, {188.4, 573.9}, {328.603, 
  572.064}, {623.13, 571.685}, {705.458, 572.25}, {413.912, 
  569.794}, {503.067, 567.867}, {70.5, 566.094}, {158.737, 
  565.737}, {244.952, 566.339}, {593.227, 563.091}, {675.5, 560.796}}

enter image description here

How can I fastest calculate the mean of the next nearest neighbor distances, not counting duplicates?

I used the code of Szabolcs (below) and superposed the connection lines:

enter image description here

Another example with more coordinates and same x and y aspect ratio gives (which helps):

enter image description here

enter image description here

$\endgroup$
0

3 Answers 3

10
$\begingroup$

Is this what you are looking for?

Mean[
  EdgeList@NearestNeighborGraph[list, 1] /. 
  UndirectedEdge -> EuclideanDistance
]
$\endgroup$
4
  • $\begingroup$ I think that is the solution ... is it possible to show the connection lines to the next neighbors in the upper image? Then I am convinced. $\endgroup$
    – mrz
    Dec 18, 2015 at 10:25
  • $\begingroup$ @mrz Yes, NearestNeighborGraph[list, 1] will show that. Now what is bother me is that NearestNeighborGraph[list] does not connect all points when I use your coordinates. This is weird, and I think it's incorrect. I just wrote to support to ask about it. $\endgroup$
    – Szabolcs
    Dec 18, 2015 at 10:41
  • $\begingroup$ @Szalbos: What do think about the other data set (please see plots above)? Do you see there the same problem? I only want to see connections between next neighbors. To me your solution NearestNeighborGraph[list, 1] looks correct. $\endgroup$
    – mrz
    Dec 18, 2015 at 11:01
  • $\begingroup$ @mrz Yes, if you use NearestNeighborGraph[list, 1], it seems to always return the correct result. But NearestNeighborGraph[list] (without the second argument) seems not to connect each point in some rare cases. $\endgroup$
    – Szabolcs
    Dec 18, 2015 at 11:07
5
$\begingroup$

Correction I have voted for Szabolcs excellent answer. My original post was aimed to confirm result and though producing a correct result for this particular set of points it was fundamentally flawed.

I post now a corrected version to deal with fundamental error pointed out by Dr.belisarius (in dealing with nearest points common to different points):

test = {{1, 0}, {2, 0}, {3, 0}, {12, 0}};
f[u_] := Mean@
  Values[GroupBy[
    Sort[{##}] -> EuclideanDistance[##] & @@@ (Nearest[u, #, 2] & /@ 
       u), First -> Last, First]]
e[u_] := Keys[
  GroupBy[Sort[{##}] -> 
      EuclideanDistance[##] & @@@ (Nearest[u, #, 2] & /@ u), 
   First -> Last, First]]
f[list]
f[test]
Show[Graphics[MapIndexed[Text[#2[[1]], #1] &, list], 
  AspectRatio -> Automatic, Frame -> True], Graphics[Line /@ e[list]]]

f[list] yielding: 51.0703 and f[test] (from belisarius): 11/3.

The graphic is consistent with the nearest neighbor graph:

enter image description here

$\endgroup$
5
  • $\begingroup$ Does this work with list ={{1,0},{2,0},{3,0},{12,0}} or does it return 5? $\endgroup$ Dec 18, 2015 at 14:02
  • $\begingroup$ @Dr.belisarius Thank you! I have made a mistake.(1+1+9)/4=11/3...min of distance: 1,1,,9...so you are right the union collapses to 5! Feeling stupid now...have hopefully corrected...Szabolcs answer is wonderful and why I voted for it, Thank you again for vigilance :) $\endgroup$
    – ubpdqn
    Dec 18, 2015 at 16:00
  • $\begingroup$ f = Nearest[list]; EuclideanDistance @@@ (Sort /@ ({#, Last@f[#, 2]} & /@ list) // Union) // Mean in V9 $\endgroup$ Dec 18, 2015 at 16:19
  • $\begingroup$ @Dr.belisarius thank you...my brain is too rattled right now...is this a neater way or exposure of another error? Off to sleep either way...what is 2 2 argument f? $\endgroup$
    – ubpdqn
    Dec 18, 2015 at 16:24
  • $\begingroup$ It's a V9 calc,similar to yours. f[#,2] is the same as Nearest[list, #, 2], but usually better because it precalculates the NearestFunction. $\endgroup$ Dec 18, 2015 at 16:29
4
$\begingroup$
list =
  {{533.286, 574.643}, {13.4032, 571.984}, {188.4, 573.9}, {328.603, 572.064}, 
   {623.13, 571.685}, {705.458, 572.25}, {413.912, 569.794}, 
   {503.067, 567.867}, {70.5, 566.094}, {158.737, 565.737},
   {244.952, 566.339}, {593.227, 563.091}, {675.5, 560.796}};

res = 
   Union@Map[Sort, {#, Flatten@Nearest[DeleteCases[list, #], #]} & /@ list];

dis = EuclideanDistance @@@ res;

Mean@dis

51.0703

bub =
  BubbleChart[
   Block[{i = 1},  res /. {a_Real, b_} :> {a, b, Riffle[dis, dis][[i++]]}],
   ChartStyle -> [email protected]];

arr = Graphics[Arrow /@ res];

txt =
  Graphics@MapThread[Text, 
     {Partition[Flatten[Position[list, #] & /@ Flatten[res, 1]], 2], 
      res[[All, 1]]}];

Show[
 bub, arr, txt,
 GridLines -> Automatic,
 GridLinesStyle -> Directive[Gray, Dashed],
 ImageSize -> Large]

enter image description here

$\endgroup$
1
  • $\begingroup$ I like type use of bubble chart :) $\endgroup$
    – ubpdqn
    Dec 19, 2015 at 6:42

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.