Polygon with an extended Boundary

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"}]

example

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]

enter image description here

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]

enter image description here

SeedRandom[77]
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]

enter image description here

Show[Graphics[{Opacity[.5], Red, Polygon @ myCoordinates3}], 
 DiscretizeRegion[Polygon @ polygonInflate[-.2] @ myCoordinates3]], 
 PlotRange -> RegionBounds[Polygon @ myCoordinates3], 
 PlotRangePadding -> Scaled[.1], ImageSize -> Large]

enter image description here

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}]

enter image description here


You can use TransformedRegion with a ScalingTransform. Your polygon:

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

Using TransformedRegion:

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}]

enter image description here