6
$\begingroup$

Given a 2D Mathematica Region, e.g. A = Region[RegionDifference[Disk[{0, 0}, 2], Disk[{2, 0}, 1]]], how can I grow the region by an arbitrary radius r? For example, automatically compute the region outlined in black for r = 1/2 in

Show[A, Graphics[{Circle[{0, 0}, 2.5, {.55, 5.8}],
   Circle[{2, 0}, .5, {1.72, 4.5}],
   Circle[{1.75, .98}, .5, {5, 7}],
   Circle[{1.75, -.98}, .5, {5.9, 7.55}],
   Red, Point[{1.73, .98}]}]] 

Outline of a region grown by a radius of 1/2.

In CGAL, the operation of computing the Minkowski sum P⊕Br of a polygon P with a disc Br of radius r centered at the origin is widely known as offsetting the polygon P by a radius r.

A typical example is convex polygon or enter image description here.

I'd like to end with a Region because of the many built-in functions that Mathematica provides. This is similar to Dilation of a BinaryImage, but for my purposes a Region is better than a BinaryImage. This post suggested trying Clipper, but I'd like to remain in Mathematica.

$\endgroup$
2
5
$\begingroup$

OP and reply the comment.

reg1 = Disk[{0, 0}, 1/2]; 
reg2 = 
 ImplicitRegion[u^2 + v^2 <= 4 && 3 + u^2 + v^2 >= 4 u, {u, v}];
 sol =
  Resolve[Exists[{x, y, u, v}, 
   Element[{x, y}, reg1] && 
    Element[{u, v}, reg2], (p == x + u && q == y + v)], 
  Reals]; RegionPlot[List @@ sol, {p, -4, 4}, {q, -4, 4}, 
 PlotPoints -> 80, BoundaryStyle -> Red]

enter image description here

reg1 = Disk[{0, 0}, {3, 2}]; 
reg2 = 
 ImplicitRegion[u^2 + v^2 <= 4 && 3 + u^2 + v^2 >= 4 u, {u, v}]; 
sol =
  Resolve[Exists[{x, y, u, v}, 
   Element[{x, y}, reg1] && 
    Element[{u, v}, reg2], (p == x + u && q == y + v)], Reals];
RegionPlot[List @@ sol, {p, -8, 8}, {q, -8, 8}, PlotPoints -> 80, 
 BoundaryStyle -> Red]

enter image description here

Edit

For two simple regions some times it work. (for example elliptical disk and rectangle)

reg = ParametricRegion[{{x, y} + {u, v}, {x, y} ∈ 
      Disk[{0, 0}, {3, 2}] && Abs[u] + Abs[v] <= 1}, {x, y, u, v}];
RegionPlot[DiscretizeRegion[reg], BoundaryStyle -> Green, 
 PlotStyle -> Gray, Frame -> False, AspectRatio -> Automatic]

enter image description here

reg1 = Disk[{0, 0}, {3, 2}];
reg2 = ImplicitRegion[Abs[u] + Abs[v] <= 1, {u, v}];
sol = Resolve[
  Exists[{x, y, u, v}, 
   Element[{x, y}, reg1] && 
    Element[{u, v}, reg2], (p == x + u && q == y + v)], Reals]
RegionPlot[List @@ sol // Evaluate, {p, -4, 4}, {q, -4, 4}]

enter image description here

Original

A simple example.

ParametricRegion[{{x, y} + {u, v}, 
   x^2 + y^2 <= 1 && Abs[u] + Abs[v] <= 1}, {x, y, u, v}] // Region

enter image description here

Or

reg = ImplicitRegion[
   x^2 + y^2 <= 1 && Abs[u] + Abs[v] <= 1, {x, y, u, v}];
sol = Resolve[
  Exists[{x, y, u, v}, 
   Element[{x, y, u, v}, reg], (p == x + u && q == y + v)], Reals]
RegionPlot[List @@ sol // Evaluate, {p, -2, 2}, {q, -2, 2}]

enter image description here

For simple region, we can also use

reg = Circle[{0, 0}, 3];
d = SignedRegionDistance[reg, {x, y}];
Show[RegionPlot[d <= 1, {x, -4, 4}, {y, -4, 4}], Graphics[reg]]
$\endgroup$
9
  • $\begingroup$ This doesn't seem to work when replacing Abs[u] + Abs[v] <= 1 with membership in an arbitrary region, such as RegionMember[A, {u, v}], unfortunately...any idea why? $\endgroup$ – thorimur Apr 14 at 2:59
  • $\begingroup$ cvgmt uses my idea without any reference. $\endgroup$ – user64494 Apr 14 at 5:38
  • $\begingroup$ @cvgmt: In any case, that reference should be done. $\endgroup$ – user64494 Apr 14 at 9:46
  • $\begingroup$ @user64494 In the above link, please note that I have post the answer before you post your answer. So it is just my idea, not your idea. $\endgroup$ – cvgmt Apr 14 at 9:52
  • $\begingroup$ @cvgmt: The difference in time equals 9 minutes. $\endgroup$ – user64494 Apr 14 at 10:38
3
$\begingroup$

One approach is to decompose your region into a collection of convex regions, find the Minkowski sum of each, then union the result.

The Minkowski sum of two convex polygonal regions is a call to ConvexHullMesh after replacing each vertex of one region with all offset vertices of the other.

A = BoundaryDiscretizeRegion[RegionDifference[Disk[{0, 0}, 2], Disk[{2, 0}, 1]]];
cpts = CirclePoints[0.5, 100];

decompcoords = PolygonCoordinates /@ PolygonDecomposition[A, "Convex"];

offsetcoords = Table[Join @@ Outer[Plus, dc, cpts, 1], {dc, decompcoords}];

RegionUnion @@ ConvexHullMesh /@ offsetcoords

$\endgroup$
1
  • $\begingroup$ A good code is a commented code. Your & /@ #))& /@ decompcoords; as well as other pieces of your code are not understable for me. Such type answers do not make a good impression and are useless for an average Mathematica user. $\endgroup$ – user64494 Apr 14 at 12:08
2
$\begingroup$

Minkovski sum is not substantial here. In fact, the $\frac 1 2$-neighborhood of RegionDifference[Disk[{0, 0}, 2], Disk[{2, 0}, 1]] is required. Following the documentation, this can be done as follows. First, we define

d = RegionDistance[DiscretizeRegion[RegionDifference[Disk[{0, 0}, 2], Disk[{2, 0}, 1]]], {x, y}];

The above does not work without DiscretizeRegion for me.

Then,

RegionPlot[d <= 1/2, {x, -3, 3}, {y, -3, 3}]

enter image description here

Addition. I'd like to explain why the similar approaches from that post do not work here. We start from

RegionMember[RegionDifference[Disk[{0, 0}, 2], Disk[{2, 0}, 1]], {x, y}]

(x | y) \[Element] Reals && x^2 + y^2 <= 4 && 3 + x^2 + y^2 > 4 x

Next,

r = 1/2; ms = Resolve[Exists[{x, y, s, t}, a == x + s && b == y + t && 
x^2 + y^2 <= 4 &&  3 + x^2 + y^2 > 4 x && (s - x)^2 + (t - y)^2 <= r^2], Reals];
LeafCount[ms]

99435

We see ms is too complicated and big to work with. This also explains the necessity of DiscretizeRegion in the above.

$\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.