6

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.

Aaron T. Becker
  • 333
  • 1
  • 5

3 Answers3

5

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]]
cvgmt
  • 72,231
  • 4
  • 75
  • 133
  • 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? – thorimur Apr 14 '21 at 02:59
  • cvgmt uses my idea without any reference. – user64494 Apr 14 '21 at 05:38
  • @cvgmt: In any case, that reference should be done. – user64494 Apr 14 '21 at 09:46
  • 1
    @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. – cvgmt Apr 14 '21 at 09:52
  • @cvgmt: The difference in time equals 9 minutes. – user64494 Apr 14 '21 at 10:38
  • 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 // Evaluate, {p, -8, 8}, {q, -8, 8}] – cvgmt Apr 14 '21 at 12:27
  • 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 // Evaluate, {p, -4, 4}, {q, -4, 4}, PlotPoints -> 80] – cvgmt Apr 14 '21 at 12:30
  • @cvgmt: What do you want to say in your latest comment? The code eg1 = 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 // Evaluate, {p, -8, 8}, {q, -8, 8}] produces an empty plot and a big output. A good code is a commented code. If you read my answer, maybe, you will understand the deficiency of our approaches with Resolve. – user64494 Apr 14 '21 at 13:20
  • +1. Now your code at the top works. – user64494 Apr 14 '21 at 14:05
3

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

Greg Hurst
  • 35,921
  • 1
  • 90
  • 136
  • 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. – user64494 Apr 14 '21 at 12:08
2

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.

user64494
  • 26,149
  • 4
  • 27
  • 56