Plot the minimum distance between two sets of data?

Questions
,
1

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]]
2

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]]
3

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]]

Nov-11-201619-50-15.gif

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

4

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

5

Thanks for the improved solution!

6

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.