Message Boards Message Boards

Plot the minimum distance between two sets of data?

Posted 8 years ago

Hi,

Can someone help me to plot the minimum distance between these two sets of data?

data1 = {{ 
     0.69224100, 0.06712100, 3.46662300},
    {1.35464400, -1.04319700, 4.09126900},
    {0.59603800, -2.24060100 , 3.81522700},
   {-0.54249500, -1.88337000 , 3.01777600},
   {-0.61503500, -0.39880700 , 2.93006500},
   { 2.74394700, -1.10522700 , 4.15251300},
   { 3.42666700, -2.35760700 , 3.92327300},
   { 2.70390400, -3.49851300 , 3.65977300},
   { 1.26064900, -3.44730700 , 3.61354900},
   { 0.84111700, -4.31753100 , 2.55852100},
   {-0.22094600, -3.94955800 , 1.75550100},
   {-0.92885600, -2.71776300 , 1.98845700},
   {-1.28585300, -2.18638800 , 0.67104300},
   {-1.23147900, -0.84400300 , 0.42313000},
   {-0.99561000 , 0.17111400 , 1.47441400},
   {-0.00687900 , 1.09338600, 0.86950300},
   { 1.09363200 , 1.56458800 , 1.53177200},
   { 1.45416300, 1.04134800 , 2.85271400},
   { 2.89180700 , 0.96197300 , 2.88469800},
   { 3.52637700, -0.07860900 , 3.53407300},
   { 2.32094600 , 1.80473400 , 0.79963300},
   { 3.41955000 , 1.44873300 , 1.62744200},
   { 4.64425800, -2.08793600 , 3.18403500},
   { 4.70330700, -0.68744000 , 2.94057300},
   { 0.09459800 , 0.79852400, -0.53662900},
   {-0.65290500, -0.37629900, -0.80861400},
   {-0.79964000, -3.11471300, -0.33150300},
   {-0.15802900, -4.19720500 , 0.32974300},
   { 2.01881800, -4.92562000 , 1.96485200},
   { 3.16398300, -4.42596700 , 2.64532300},
   { 4.39395400, -4.23506900 , 1.97290600},
    {5.16478100, -3.01732900 , 2.25335600},
    {5.28811100, -0.16990700 , 1.76290400},
    {4.62356200 , 0.94751300 , 1.08084000},
    {2.39624300 , 1.66461500, -0.60238500},
    {1.23503400 , 1.13000800, -1.29585300},
   {-0.36723400, -2.68408400, -1.60901400},
   {-0.28915600, -1.24948000, -1.85685100},
   { 2.06737700, -5.25628900 , 0.59229400},
   { 0.93177800, -4.88059600, -0.25952500},
   { 4.49990200, -4.82102400 , 0.69204900},
   { 3.35497500, -5.32319000 , 0.01299600},
   { 6.04010100, -1.08254200 , 0.98865200},
   { 5.97925100, -2.48312200 , 1.22998700},
   { 4.77566400, 1.07367900, -0.31923900},
   { 3.67725600, 1.42579900, -1.14724000},
   { 1.17240700, -4.61698400, -1.62728900},
   { 0.53407000, -3.53430200, -2.29123900},
   { 0.67111700, -0.76232700, -2.77116700},
   { 1.42037600, 0.41183000, -2.49442200},
   { 2.73452100, 0.26261500, -3.08463400},
   { 3.83832700, 0.75615400, -2.42380500},
   { 5.62983600, 0.17320300, -1.07220200},
   { 6.24661800, -0.87934000, -0.43425000},
   { 6.14139100, -3.16167800, -0.04351500},
   { 5.41900500, -4.30369700, -0.30620500},
   { 3.55663800, -5.12877400, -1.41116600},
   { 2.49065000, -4.78483600, -2.21144200},
   { 1.51602900, -1.66278400, -3.52986100},
   { 1.44977000, -3.01793800, -3.29279400},
   { 4.84411800, -4.50985100, -1.61360800},
   { 2.66095200, -3.80319600, -3.25643000},
   { 2.79584500, -1.02457300, -3.73922800},
   { 5.05964700, -0.01342400, -2.38625100},
   { 6.32542500, -2.16944900, -1.07534900},
   { 5.12533100, -1.25336700, -3.00772800},
   { 5.77516500, -2.35953700, -2.33678600},
   { 5.01547300, -3.55951800, -2.61254100},
   { 3.96358600, -1.77182900, -3.70132000},
   { 3.89480700, -3.19788800, -3.45431300}};
data2 = {{-0.43066100, 3.22207100, -3.38105100},
   {-1.08754800, 3.55679200, -2.18130200},
   {-0.41378000 , 4.26254700, -1.18265300},
   { 0.92736600 , 4.58518900, -1.38154500},
   { 1.60591600, 4.18103600, -2.55284500},
    {0.90839900 , 3.52334900, -3.56516100},
    {3.08218500 , 5.15537600, -1.10287200},
    {4.31271100 , 5.56664800, -0.58728000},
    {5.44654700 , 5.33373000, -1.35333300},
    {5.37132000 , 4.70793400, -2.60621300},
    {4.14731100 , 4.30443700, -3.11721100},
    {2.99390000 , 4.53032900, -2.36511200},
    {1.82106300 , 5.20847300, -0.52086200},
   {-2.45218900 , 3.09008000, -1.89962700},
   {-3.39745700, 3.67765900, -1.09950700},
   {-4.53867700 , 2.86750700, -0.88811600},
   {-4.47012800 , 1.65785700, -1.53853800},
   {-2.97422100 , 1.51969600, -2.41016700},
   {-5.48081300 , 0.60124900, -1.51116200},
   {-5.14776900, -0.79336900, -1.58617900},
   {-6.81308000 , 0.88358000, -1.33237400},
   {-6.15938600, -1.81514400, -1.45121500},
   {-7.80732700, -0.12056800, -1.18775500},
   {-7.54006300, -1.46903300, -1.23921900},
   {-5.66052200, -3.04942500, -1.52745300},
   {-3.92076500, -1.28785400, -1.75139100},
   {-4.05831400, -2.90428300, -1.74022000},
   {-8.57917700, -2.48726200, -1.08180700},
   {-8.44732000, -3.81630200, -0.76606300},
   {-10.26395600, -2.07482300, -1.27177600},
   {-9.69322500, -4.49577400, -0.66520900},
   {-10.75909500, -3.68261500, -0.91023100}};

data3 = Outer[EuclideanDistance, data1, data2, 1] // Flatten;
distance = Min@data3
Show[ListPointPlot3D[{data1, data2}, 
  PlotStyle -> {Directive[PointSize[Large], Red], 
    Directive[PointSize[Large], Green]}], 
 Graphics3D[{{PointSize[Large], Blue, Point[distance]}, {Thick, Blue, 
    Line[distance]}}], SphericalRegion -> True, BoxRatios -> 1, 
 PlotRange -> 6, ImageSize -> 500, 
 PlotLabel -> Framed@Style["distance = " <> ToString[distance], 20]]
POSTED BY: SAMM Hill
5 Replies

It can actually be done even faster by using Nearest:

nf = Nearest[data1 -> Automatic];
ClearAll[func]
func[nf_NearestFunction, pt_] := Module[{tmp},
  tmp = First[nf[pt]];
  {tmp, EuclideanDistance[data1[[tmp]], pt]}
  ]
MapIndexed[Prepend[func[nf, #1], First[#2]] &, data2]
First[TakeSmallestBy[%, Last, 1]]

this should have n log(m) or n log(m) scaling depending which of the two sets is the largest. Basically for each point in dataset 1, it only does a quick search in the other dataset. But distancematrix is very very optimized and the prefactor is probably much smaller than my nearest method. But for large datasets it should be faster.

POSTED BY: Sander Huisman

Hi Samm,

I am not sure whether this is what you need:

closepoints = {data1[[#[[1]]]], data2[[#[[2]]]]} &@Flatten[Position[#, Min[#, Infinity]] &@ DistanceMatrix[data1, data2]]; Show[
ListPointPlot3D[{data1, data2}, PlotStyle -> {Directive[PointSize[Large], Red], Directive[PointSize[Large], Green]}], 
Graphics3D[{{PointSize[Large], Blue, Point[#] & /@ closepoints}, {Thick, Blue, Line[closepoints]}}], 
SphericalRegion -> True, BoxRatios -> 1, PlotRange -> 6, ImageSize -> 500, 
PlotLabel -> Framed@Style["distance = " <> ToString[distance], 20]]

enter image description here

The problem in your code was that you did not give it the coordinates of the closest elements for the line and the blue starting and end markers.

Cheers,

Marco

POSTED BY: Marco Thiel

Your variable distance is a number, not a point. I suggest the following.

dists = Association@Flatten@Outer[({#1, #2} -> EuclideanDistance[#1, #2]) &, data1, data2, 1];
mind = Min[dists];
minpnts = First@Keys@Select[dists, # == mind &];

Then

Show[ListPointPlot3D[{data1, data2}, 
  PlotStyle -> {Directive[PointSize[Large], Red], 
    Directive[PointSize[Large], Green]}], 
 Graphics3D[{{PointSize[Large], Blue, Point /@ minpnts}, {Thick, Blue,
     Line[minpnts]}}], SphericalRegion -> True, BoxRatios -> 1, 
 PlotRange -> 6, ImageSize -> 500, 
 PlotLabel -> Framed@Style["distance = " <> ToString[distance], 20]]
POSTED BY: John McGee

Sorry, I did not want to cross post, but your post did not show up until after I posted. I wouldn't have posted had I seen yours. I did use DistanceMatrix though, this is about 10 times faster than the Outer ... solution and slightly less than 5 times faster then the Outer solution of the OP.

Marco

POSTED BY: Marco Thiel

Thanks for the improved solution!

POSTED BY: John McGee
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract