Message Boards

WOLFRAM COMMUNITY

3909 Views

2 Replies

4 Total Likes

View groups...

Follow this post

Share this post:

GROUPS:

Finding the largest disk which fits inside a nonconvex Polygon

Frank Kampas

Frank Kampas, Physicist at Large Consulting

Posted 7 years ago

Find the largest disk which fits inside a given rectangle poly poly = Polygon[{{-1, -1}, {1, -1}, {1, 1}, {-1, 1}}]; AbsoluteTiming @ Maximize[{r, RegionWithin[poly, Disk[{x, y}, r]], r > 0}, {r, x, y}] {0.0856107, {1, {r -> 1, x -> 0, y -> 0}}} AbsoluteTiming @ NMaximize[{r, RegionWithin[poly, Disk[{x, y}, r]], r > 0}, {r, x, y}] {0.0178753, {1., {r -> 1., x -> 0., y -> 0.}}} The approach which works for the rectangle doesn't in any reasonable time for a nonconvex polygon. poly = Polygon[{{-1, -1}, {1, -1}, {1, 1}, {0, 1/2}, {-1, 1}}]; TimeConstrained[ Maximize[{r, RegionWithin[poly, Disk[{x, y}, r]], r > 0}, {r, x, y}], 100] $Aborted TimeConstrained[ NMaximize[{r, RegionWithin[poly, Disk[{x, y}, r]], r > 0}, {r, x, y}], 100] $Aborted Define a function which find the maximum disk radius as a function of the coordinates of the disk center and maximize that. ar[x_?NumberQ, y_?NumberQ] := FindMaxValue[{r, RegionWithin[poly, Disk[{x, y}, r]], r > 0}, {r}] AbsoluteTiming[sln = FindMaximum[ar[x, y], {{x, 0.5}, {y, 0}}]] FindMaximum::lstol: The line search decreased the step size to within the tolerance specified by AccuracyGoal and PrecisionGoal but was unable to find a sufficient increase in the function. You may need more than MachinePrecision digits of working precision to meet these tolerances. {1.9142, {0.767949, {x -> 0.232051, y -> -0.232051}}} Show[Graphics @{Opacity[0.3], Green, poly}, Graphics @ {Opacity[0.3], Red, Disk[{x, y} /. sln[[2]], sln[[1]]]}, ImageSize -> Small, Axes -> True]

Find the largest disk which fits inside a given rectangle poly

poly = Polygon[{{-1, -1}, {1, -1}, {1, 1}, {-1, 1}}];

AbsoluteTiming @ 
 Maximize[{r, RegionWithin[poly, Disk[{x, y}, r]], r > 0}, {r, x, y}]

{0.0856107, {1, {r -> 1, x -> 0, y -> 0}}}

AbsoluteTiming @ 
 NMaximize[{r, RegionWithin[poly, Disk[{x, y}, r]], r > 0}, {r, x, y}]

{0.0178753, {1., {r -> 1., x -> 0., y -> 0.}}}

The approach which works for the rectangle doesn't in any reasonable time for a nonconvex polygon.

poly = Polygon[{{-1, -1}, {1, -1}, {1, 1}, {0, 1/2}, {-1, 1}}];

TimeConstrained[
 Maximize[{r, RegionWithin[poly, Disk[{x, y}, r]], r > 0}, {r, x, y}], 100]

$Aborted

TimeConstrained[
 NMaximize[{r, RegionWithin[poly, Disk[{x, y}, r]], r > 0}, {r, x, y}], 100]

$Aborted

 Define a function which find the maximum disk radius as a function of the coordinates of the disk center and maximize that.

ar[x_?NumberQ, y_?NumberQ] := 
 FindMaxValue[{r, RegionWithin[poly, Disk[{x, y}, r]], r > 0}, {r}]

AbsoluteTiming[sln = FindMaximum[ar[x, y], {{x, 0.5}, {y, 0}}]]

FindMaximum::lstol: The line search decreased the step size to within the tolerance specified by AccuracyGoal and PrecisionGoal but was unable to find a sufficient increase in the function. You may need more than MachinePrecision digits of working precision to meet these tolerances.

{1.9142, {0.767949, {x -> 0.232051, y -> -0.232051}}}

Show[Graphics @{Opacity[0.3], Green, poly}, 
 Graphics @ {Opacity[0.3], Red, Disk[{x, y} /. sln[[2]], sln[[1]]]}, 
 ImageSize -> Small, Axes -> True]

enter image description here

POSTED BY: Frank Kampas

2 Replies

Sort By:

Gianluca Gorni

Gianluca Gorni, University of Udine

Posted 7 years ago

An approach that uses `RegionPlot3D` and the internal structure of `Graphics3D`: poly = Polygon[{{-1, -1}, {1, -1}, {1, 1}, {0, 1/2}, {-1, 1}}]; regPl = RegionPlot3D[RegionWithin[poly, Disk[{x, y}, r]] && r >= 0, {x, -1.5, 1.5}, {y, -1.5, 1.5}, {r, -.1, .8}] TakeLargestBy[regPl[[1, 1]], Last, 2]

An approach that uses RegionPlot3D and the internal structure of Graphics3D:

poly = Polygon[{{-1, -1}, {1, -1}, {1, 1}, {0, 1/2}, {-1, 1}}];
regPl = RegionPlot3D[RegionWithin[poly, Disk[{x, y}, r]] && r >= 0,
  {x, -1.5, 1.5}, {y, -1.5, 1.5}, {r, -.1, .8}]
TakeLargestBy[regPl[[1, 1]], Last, 2]

POSTED BY: Gianluca Gorni