# Polygon with an extended Boundary

I have a (not necessarily convex) Polygon, and want to create another Region that can be seen as an extended boundary of the first polygon.

It should be quite simple; I tried it by creating a second polygon with 10% larger size, that I shift. It works for simple shapes such as squares, but it doesn't produce a boundary for different shapes.

myCoordinates = {{0, 0}, {0, 1}, {1, 1}, {1, 0}};
mypolygon = Polygon[myCoordinates];
dilatation = 1.1;
maxX = Max[myCoordinates[[;; , 1]]];
maxY = Max[myCoordinates[[;; , 2]]];
myCoordinatesLarge = dilatation*myCoordinates;
myCoordinatesLarge[[;; , 1]] -= (dilatation - 1)*maxX/2;
myCoordinatesLarge[[;; , 2]] -= (dilatation - 1)*maxY/2;
mypolygon2 = Polygon[myCoordinatesLarge];

RR = RegionIntersection[mypolygon2, mypolygon]
Show[Graphics[{LightBlue, EdgeForm[Gray], mypolygon, mypolygon2}], HighlightMesh[DiscretizeRegion[RR], 2]] However, if my coordinates are

myCoordinates = {{0, 0}, {0, 1}, {3, 0}};


then I get this area without a boundary at the hypotenuse The best would be to start from RegionCentroid[mypolygon] and inflate the polygon without changing its RegionCentroid, but I don't know how to do this.

Update: The method in the answers works for simple shapes such as squares or triangles, but if I have slightly more complex shapes, the result has no real boundary

myCoordinates = {{0, 0}, {0, 1}, {1, 1}, {2, 0}, {0.5, 0.5}};
mypolygon = Polygon[myCoordinates];
mypolygon2 = TransformedRegion[mypolygon, ScalingTransform[{2, 2}, RegionCentroid[mypolygon]]];
RR = RegionIntersection[mypolygon2, mypolygon];
Show[Graphics[{LightBlue, EdgeForm[Gray], mypolygon, mypolygon2}], HighlightMesh[DiscretizeRegion[RR], 2]] • mypolygon2 = Scale[ mypolygon, 1.5, RegionCentroid[ mypolygon ] ] – LouisB Dec 23 '19 at 6:28
• Wow that is the direct way how I expected it. However unfortunatly the boundary on the left is larger than on the bottom and at the hypothenuse. Do you know how to make the boundary equal at all sides? Thanks so much! – Mario Krenn Dec 23 '19 at 6:32

Here is a function that inflates a polygon. It creates a new polygon whose sides are parallel to the original, but displaced by a specified difference. Actually, it takes the coordinates of polygon vertices, not a Polygon object. Here's the function definition:

Clear[inflate]
inflate[gap_, pts_] := With[{
c = Join[pts[[-1 ;;]], pts, pts[[;; 1]]]},
Table[Block[{dir1, dir2, dist1, dist2,
p1, p2, p3, perp1, perp2, q1, q2, q3, q4, x, y},
{p1, p2, p3} = {c[[n - 1]], c[[n]], c[[n + 1]]};
{dist1, dist2} = Norm /@ {p2 - p1, p3 - p2};
{dir1, dir2} = {p2 - p1, p3 - p2}/{dist1, dist2};
{perp1, perp2} = {{-Last[dir1], First[dir1]},
{-Last[dir2], First[dir2]}};
{q1, q2} = With[{delta = gap*perp1}, {p1 + delta, p2 + delta}];
{q3, q4} = With[{delta = gap*perp2}, {p2 + delta, p3 + delta}];
eqn1 = With[{delta = q2 - q1, pt = {x, y} - q1},
First[delta] Last[pt] == Last[delta] First[pt]];
eqn2 = With[{delta = q4 - q3, pt = {x, y} - q3},
First[delta] Last[pt] == Last[delta] First[pt]];
{x, y} /. First@Solve[{eqn1, eqn2}, {x, y}]],
{n, 2, Length[pts] + 1}]]


Here is an example of how it can be used with one of your coordinate lists.

coords = {{0, 0}, {0, 1}, {1, 1}, {2, 0}, {1/2, 1/2}};
poly1 = Polygon[coords];
Manipulate[
poly2 = Polygon[offset[gap, coords]];
Show[Graphics[{EdgeForm[Gray], Opacity[1/3], Blue, poly1,
EdgeForm[Black], LightBlue, poly2}],
PlotRange -> {{-1, 4}, {-1, 2}}, Axes -> True],
{{gap, 1/4}, 0, 1/2, Appearance -> "Labeled"}] How does it work?
Take three consecutive vertices, $$p_1$$, $$p_2$$, $$p_3$$. The line $$p_1p_2$$ gets moved perpendicular to itself, and $$p_2p_3$$ moves perpendicular to itself. The intersection of the new lines is a vertex of the inflated polygon.

So, calculate the direction (cosines) from $$p_1$$ to $$p_2$$, then find the perpendicular direction. Translate $$p_1$$ and $$p_2$$ by the gap distance to points $$q_1$$ and $$q_2$$. Likewise, translate $$p_2$$ and $$p_3$$ perpendicular to $$p_2p_3$$ to get points $$q_3$$ and $$q_4$$. Use the two-point form to get equations for lines $$q_1q_2$$ and $$q_3q_4$$. Solve the equations for the intersection.

Use Table to loop over the list of coordinates. To make the iteration easier, use With to extend the coordinate list forward and backwards. This implementation is pretty inefficient: each direction, displacement, equation, etc., is calculated twice.

The same function will deflate a polygon if the gap is negative, or if the coordinate list is reversed.

ClearAll[polygonInflate]
polygonInflate[δ_][coords_] := Module[{inflines = InfiniteLine /@
Partition[coords, 2, 1, {1, 1}],
trs = TranslationTransform /@ (δ (Cross /@
Normalize /@ Differences[Append[coords, First@coords]]))},
RegionIntersection @@@
Partition[MapThread[TransformedRegion, {inflines, trs}], 2, 1, {1, 1}] /.
Point[x_] :> x]


Examples:

myCoordinates1 = {{0, 0}, {0, 1}, {3, 0}};

Graphics[{ Opacity[.5], Red, Polygon@myCoordinates1, Blue,
Polygon @ polygonInflate[-.1] @ myCoordinates1},
PlotRange -> RegionBounds[Polygon@myCoordinates1],
PlotRangePadding -> Scaled[.1], ImageSize -> Large]

myCoordinates2 = {{0, 0}, {0, 1}, {1, 1}, {2, 0}, {0.5, 0.5}};

Graphics[{ Opacity[.5], Red, Polygon@myCoordinates2, Blue,
Polygon @ polygonInflate[-.1] @ myCoordinates2},
PlotRange -> RegionBounds[Polygon@myCoordinates2],
PlotRangePadding -> Scaled[.1], ImageSize -> Large] SeedRandom
myCoordinates3 = Reverse@#[[Most@Last@FindShortestTour[#]]] &@RandomReal[5, {12, 2}];

Graphics[{ Opacity[.5], Red, Polygon @ myCoordinates3, Blue,
Polygon @ polygonInflate[-.2] @ myCoordinates3},
PlotRange -> RegionBounds[Polygon @ myCoordinates3],
PlotRangePadding -> Scaled[.1], ImageSize -> Large] Show[Graphics[{Opacity[.5], Red, Polygon @ myCoordinates3}],
DiscretizeRegion[Polygon @ polygonInflate[-.2] @ myCoordinates3]],
PlotRange -> RegionBounds[Polygon @ myCoordinates3],
PlotRangePadding -> Scaled[.1], ImageSize -> Large] Update: Slightly streamlined implementation of @LouisB's cool idea:

Clear[findCoordsF, inflateF]
findCoordsF[gap_] := Module[{perps, eqns, x, y, difs = Differences[#],
disps = #[[;; 2]] + gap (Cross /@ Normalize /@ Differences[#])},
perps = {x, y} - # & /@ disps;
eqns = difs[[#, 1]] perps[[#, 2]] == difs[[#, 2]] perps[[#, 1]] & /@ {1, 2};
{x, y} /. First@Solve[eqns, {x, y}]] &;

inflateF[gap_][pts_] := findCoordsF[gap] /@ Partition[pts, 3, 1, {2, 2}]

coords = myCoordinates2;
Manipulate[Graphics[{EdgeForm[Gray], Opacity[1/3], Blue, Polygon[c],
EdgeForm[Black], LightBlue, Polygon[inflateF[gap][c]]},
PlotRange -> All, Axes -> False],
{{gap, .1}, -1/2, 1/2, Appearance -> "Labeled"},
{{c, coords}, Locator}] This is the same as Louis's idea, but I was able to devise a much shorter implementation, which does not rely on Solve[]:

(* intersection of two lines; cf. https://mathematica.stackexchange.com/a/85903 *)
lis[{{p1_, d1_}, {p2_, d2_}}] := With[{sol = LeastSquares[Transpose[{d1, d2}], p2 - p1]},
Mean[{p1 + sol[] d1, p2 - sol[] d2}]]

(* https://mathematica.stackexchange.com/a/22587 *)
PolygonSignedArea[pts_?MatrixQ] := Total[Det /@ Partition[pts, 2, 1, 1]]/2

PolygonInflate[Polygon[p1_?MatrixQ], h_?NumericQ] := Module[{sides, sig},
sig = Sign[PolygonSignedArea[p1]];
sides = With[{d = Normalize[Subtract @@ #]}, {Mean[#] + h sig Cross[d], d}] & /@
Partition[p1, 2, 1, 1];
Polygon[RotateRight[lis /@ Partition[sides, 2, 1, 1]]]]


As a demonstration:

p1 = {{0, 0}, {0, 1}, {1, 1}, {2, 0}, {1/2, 1/2}};

Manipulate[Graphics[{{Red, PolygonInflate[Polygon[p1], h]},
{Opacity[1/2, Blue], Polygon[p1]}},
PlotRange -> {{-1, 3}, {-1, 3}}],
{{h, 0}, -1, 1}] A more difficult example:

poly = GraphicsPolygonUtilsPolygonData["Test01", "Polygon"];

Graphics[{{Red, PolygonInflate[poly, 1/5]}, {Blue, poly},
{Yellow, PolygonInflate[poly, -1/5]}}] You can use TransformedRegion with a ScalingTransform. Your polygon:

p = Polygon[{{0, 0}, {0, 1}, {3, 0}}];

extended = TransformedRegion[
p,
ScalingTransform[{1.1, 1.1}, RegionCentroid[p]]
]


Polygon[{{-0.10000000000000009, -0.03333333333333338}, {-0.10000000000000009, 1.0666666666666667}, {3.2, -0.03333333333333338}}, {1, 3, 2}]

Check:

Graphics[{Red, extended, Blue, p}] • That is really cool. I did the same, but with a really ugly for-loop. What is strange in this solution is that the boundary on the left is larger than the bournary on the bottom and the hypothenus. Do you have an idea how to fix this too, and make the boundary same size at each edge? Thanks so much! – Mario Krenn Dec 23 '19 at 6:30
• I updated the example accordingly, with a more complex polygon. Do you know how to adapt your solution to create a boundary there, too? Thank you! – Mario Krenn Dec 23 '19 at 7:37