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

3 Answers 3

Reset to default
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

Improve this answer
$\endgroup$
1
  • $\begingroup$ Well,It's seem your answer first. $\endgroup$
    – yode
    Commented 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.

Improve this answer
$\endgroup$
1
  • $\begingroup$ Hm, I think because the inputs are machine precision numbers. $\endgroup$
    – Armin Vollmer
    Commented 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

Improve this answer
$\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.