6
$\begingroup$

RegionNearest gives a point in the region that is nearest another point, but what about the nearest point about another region? I'd like to find the minimum linear distance between any two points on the boundaries of two separate regions.

dm = RegionPlot@{DelaunayMesh@RandomReal[1, {25, 2}], 
   DelaunayMesh@RandomReal[{1, 2}, {25, 2}]}

enter image description here

My naive first approach is slow:

dist[r1_, r2_] := Min[EuclideanDistance[RegionNearest[r2, #], #] & /@ 
   RandomPoint[RegionBoundary[r1], 100]]
$\endgroup$
  • $\begingroup$ That's not really a very good distance measure because the dist from region1 to region2 is different from the distance between region2 and region1. $\endgroup$ – bill s Oct 27 '16 at 2:52
  • $\begingroup$ Are you restricting consideration to convex regions? $\endgroup$ – mikado Oct 27 '16 at 5:42
  • $\begingroup$ @mikado no most of my examples are concave $\endgroup$ – M.R. Oct 27 '16 at 5:53
7
$\begingroup$

NMinimize (or NMinValue) with a region constraint would work:

{r1, r2} = {DelaunayMesh@RandomReal[1, {25, 2}], 
   DelaunayMesh@RandomReal[{1, 2}, {25, 2}]};
sol = {NMinimize[RegionDistance[r1, {x, y}], {x, y} ∈ r2], 
   NMinimize[RegionDistance[r2, {x, y}], {x, y} ∈ r1]}

{{0.410122, {x -> 1.13287, y -> 1.26539}}, {0.410122, {x -> 0.859349, y -> 0.9598}}}

Visualize the output:

Show[RegionPlot[{r1, r2}], 
 Graphics[{Line[#], {PointSize[Large], Red, Point@#}} &[
   {x, y} /. sol[[All, -1]]]]]

enter image description here

$\endgroup$
  • $\begingroup$ Well,It's seem your answer first. $\endgroup$ – yode Oct 27 '16 at 3:15
5
$\begingroup$
dm = RegionPlot@{r1 = DelaunayMesh@RandomReal[1, {25, 2}], 
   r2 = DelaunayMesh@RandomReal[{1, 2}, {25, 2}]}

enter image description here

If you just want to find the min distance:

MinValue[EuclideanDistance[{x1, y1}, {x2, y2}], 
 Element[{x2, y2}, r2], {Element[{x1, y1}, r1], 
  Element[{x2, y2}, r2]}]

0.292573

If you want to find the point in the meantime.

result = Minimize[EuclideanDistance[{x1, y1}, {x2, y2}], 
  Element[{x2, y2}, r2], {Element[{x1, y1}, r1], 
   Element[{x2, y2}, r2]}]

{0.292573,{x1->0.880152,y1->0.987411,x2->1.05027,y2->1.22544}}

Show the point:

Show[dm, Graphics[{Red, PointSize[.02], 
   Point[{{x1, y1}, {x2, y2}} /. Last[result]]}]]

enter image description here

ps:But I don't know why the MinValue and Minimize all return a machine precision number.

$\endgroup$
1
$\begingroup$

For these "nice" regions:

dm = RegionPlot@{r1 = DelaunayMesh@RandomReal[1, {25, 2}], 
   r2 = DelaunayMesh@RandomReal[{1, 2}, {25, 2}]}
rb1 = RegionBoundary[r1];
rb2 = RegionBoundary[r2];
rn1 = RegionNearest[r1][MeshPrimitives[rb2, 0] /. Point[x__] :> x];
rn2 = RegionNearest[r2][MeshPrimitives[rb1, 0] /. Point[x__] :> x];
rd1 = RegionDistance[r2, #] & /@ rn1;
rd2 = RegionDistance[r1, #] & /@ rn2;
min1 = Min[rd1];
min2 = Min[rd2];
pos1 = DeleteDuplicates[Extract[rn1, Position[rd1, min1]]][[1]];
pos2 = DeleteDuplicates[Extract[rn2, Position[rd2, min2]]][[1]];
Show[dm, ListPlot[rn1], ListPlot[rn2], 
 Graphics[{PointSize[0.02], Red, Point[pos1], Green, Point[pos2], 
   Black, Line[{pos1, pos2}], 
   Text[Framed[EuclideanDistance[pos1, pos2]], (pos1 + pos2)/
     2, {1, -0.5}]}]]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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