8
$\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$
3
  • 1
    $\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, 2016 at 2:52
  • $\begingroup$ Are you restricting consideration to convex regions? $\endgroup$
    – mikado
    Oct 27, 2016 at 5:42
  • $\begingroup$ @mikado no most of my examples are concave $\endgroup$
    – M.R.
    Oct 27, 2016 at 5:53

3 Answers 3

11
$\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$
1
  • $\begingroup$ Well,It's seem your answer first. $\endgroup$
    – yode
    Oct 27, 2016 at 3:15
7
$\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$ Hm, I think because the inputs are machine precision numbers. $\endgroup$ Feb 15, 2023 at 19:31
2
$\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 and acknowledge you have read our privacy policy.

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