I have been maximizing the minimum separation between polygons, inside a border, using FindMinimum to calculate the distance between the polygons. To speed up the code, I decided to use the approach described in this notebook and realized that I could get exact answers.
Function to rotate a point around the origin by an angle θ and then translate it by {xc,yc}
In[]:=
rottrans[{xc_,yc_,θ_}][{x_,y_}]={xc,yc}+RotationMatrix[θ].{x,y};
function to calculate the distance between pt1 and pt2
In[]:=
distPtPt[pt1_List,pt2_List]=Sqrt[(pt1-pt2).(pt1-pt2)];
Parameterize a line passing through {x1,y1} and {x2,y2} using the scalar t, so that x = x1 + t(x2-x1) and y = y1 + t(y2-y1). Calculate the value of t for the point on the line for which the line {x,y} is perpendicular to the line. If 0 <= t <=1, the point is on the line between {x1,y1} and {x2,y2}.
In[]:=
perpPt[{x_,y_},{{x1_,y1_},{x2_,y2_}}]=t/.Solve[{x-(x1+t(x2-x1)),y-(y1+t(y2-y1))}.{x2-x1,y2-y1}==0,t][[1]]
Out[]=
-xx1++xx2-x1x2-yy1++yy2-y1y2
2
x1
2
y1
2
x1
2
x2
2
y1
2
y2
Calculate the distance from a point to a finite line and the coordinates of the line connecting the point to the point on the line, by first finding the value of the parameter t using perpPt. If t <=0, the closest point is the end of line for t = 0. If 0 < t < 1, then the point on the line is parametrized by t. If t >= 1, then the point on the line is the other end, the point where t = 1.
In[]:=
distPtFiniteLine[{x_,y_},{{x1_,y1_},{x2_,y2_}}]:=Module[{t=perpPt[{x,y},{{x1,y1},{x2,y2}}]},Which[t<=0,{distPtPt[{x,y},{x1,y1}],{{x,y},{x1,y1}}},0<t<1,{distPtPt[{x,y},{x1+t(x2-x1),y1+t(y2-y1)}],{{x,y},{x1+t(x2-x1),y1+t(y2-y1)}}},t>=1,{distPtPt[{x,y},{x1,y1}],{{x,y},{x1,y1}}}]]
Find the minimum distance between two polygons (described by their vertices) and the coordinates of the shortest line between the two polygons, by find the shortest distances between the points on one polygon and the sides of the other polygons, and vice versa.
In[]:=
distPolyPoly[vertices1_List,vertices2_List]:=Module[{n1=Length[vertices1],n2=Length[vertices2],lns1,lns2,distPts1Lns2,distPts2Lns1,allPtsLines,dists,order,res},lns1=Partition[vertices1,2,1,{1,1}];lns2=Partition[vertices2,2,1,{1,1}];distPts1Lns2=Flatten[Table[distPtFiniteLine[vertices1[[i]],lns2[[j]]],{i,n1},{j,n2}],1];distPts2Lns1=Flatten[Table[distPtFiniteLine[vertices2[[i]],lns1[[j]]],{i,n2},{j,n1}],1];allPtsLines=Join[distPts1Lns2,distPts2Lns1];dists=allPtsLines[[All,1]];order=Ordering[N@dists];res=allPtsLines[[order[[1]]]];Print@Show[Graphics@Polygon[vertices1],Graphics@Polygon[vertices2],Graphics@{Thick,Line[res[[2]]]},ImageSize->Small,Axes->True];res]
In[]:=
fmDistPolyPoly[vertices1_List,vertices2_List]:=FindMinimum[{distPtPt[{x1,y1},{x2,y2}],Element[{x1,y1},Polygon[vertices1]],Element[{x2,y2},Polygon[vertices2]]},{x1,y1,x2,y2}]
Test
Test
Test distPolyPoly by comparing its result to fmDistPolyPoly
Test 1
Test 1
In[]:=
distPolyPoly[rottrans[{-2,0,0}]/@CirclePoints[4],rottrans[{2,0,0}]/@CirclePoints[4]]
Out[]=
4-,-,2-,-
2
,-2+1
2
1
2
1
2
1
2
In[]:=
N[%]
Out[]=
{2.58579,{{-1.29289,-0.707107},{1.29289,-0.707107}}}
fmDistPolyPoly gives a line of the same length, but along the x-axis.
In[]:=
fmDistPolyPoly[rottrans[{-2,0,0}]/@CirclePoints[4],rottrans[{2,0,0}]/@CirclePoints[4]]
Out[]=
{2.58578,{x1-1.29289,y10.,x21.29289,y20.}}
Test 2
Test 2
In[]:=
distPolyPoly[rottrans[{-2,0,Pi/4}]/@CirclePoints[4],rottrans[{2,0,0}]/@CirclePoints[4]]
Out[]=
3-,{-1,0},2-,0
1
2
1
2
In[]:=
N[%]
Out[]=
{2.29289,{{-1.,0.},{1.29289,0.}}}
In[]:=
fmDistPolyPoly[rottrans[{-2,0,Pi/4}]/@CirclePoints[4],rottrans[{2,0,0}]/@CirclePoints[4]]
Out[]=
{2.2929,{x1-1.,y1-6.0113×,x21.2929,y24.67643×}}
-18
10
-17
10
Test 3
Test 3
In[]:=
v1=rottrans1,2,/@CirclePoints[3];v2=rottrans[{-5,-3,π/7}]/@*CirclePoints[5];
π
3
3
4
In[]:=
distPolyPolyrottrans1,2,/@CirclePoints[3],rottrans[{-2,-3,Pi/7}]/@*CirclePoints[5]
Pi
3
3
4
Out[]=
+,{1,1},-2++Cos-(-1+,-3+(-1+++Sin
2
4-(-1+-+Sin
3
16
5
)Cosπ
7
3
4
5
8
5
8
π
7
2
3-+Cos+(-1+
3
4
5
8
5
8
π
7
3
16
5
)Sinπ
7
3
4
5
8
5
8
π
7
3
16
5
)Sinπ
7
3
16
5
)Cosπ
7
3
4
5
8
5
8
π
7
In[]:=
N[%]
Out[]=
{4.26187,{{1.,1.},{-1.4579,-2.4817}}}
In[]:=
fmDistPolyPolyrottrans1,2,/@CirclePoints[3],rottrans[{-2,-3,Pi/7}]/@*CirclePoints[5]
Pi
3
3
4
Out[]=
{4.26187,{x11.,y11.,x2-1.45791,y2-2.4817}}
CITE THIS NOTEBOOK
CITE THIS NOTEBOOK
Exact Distance Between Polygons
by Frank Kampas
Wolfram Community, STAFF PICKS, November 16, 2023
https://community.wolfram.com/groups/-/m/t/3066277
by Frank Kampas
Wolfram Community, STAFF PICKS, November 16, 2023
https://community.wolfram.com/groups/-/m/t/3066277