29
$\begingroup$

I was wondering whether there is an option in Mathematica that enables me to smooth the corners of a shape. The example I want to start with is the pentagon.

This can be crudely specified as

Graphics[
  Polygon[
    {{Sin[2π/5], Cos[2π/5]}, {Sin[4π/5], -Cos[π/5]}, 
     {-Sin[4π/5], -Cos[Pi/5]}, {-Sin[2π/5], Cos[2π/5]}, 
     {0, 1}}]
]

Unfortunately, I see no easy way that enables me to round the corners. What I am after is something that looks like this:

Smooth Pentagon

I would think Mathematica would have such a feature, but I can't seem to find anything. I'd be grateful if you could shine some light on this. Maybe this isn't as trivial as it seems.

$\endgroup$
27
$\begingroup$

UPDATE:

The previous version of my answer worked, but did not give control on the rounding radius, nor did it fully work with as a starting point for a geometric region for further calculations. Here is a version that is still based on spline curves, but it gives full control over the corner rounding radius. It also returns a FilledCurve object that in my opinion is easier to style and can also be discretized reliably to use in further calculations.

Clear[splineRoundedNgon]
splineRoundedNgon[n_Integer /; n >= 3, roundingRadius_?(0 <= # <= 1 &)] :=
  Module[{vertices, circleCenters, tangentPoints, splineControlPoints},
   vertices = CirclePoints[n];
   circleCenters = CirclePoints[1 - Sec[Pi/n] roundingRadius, n];
   tangentPoints =
   {
    Table[RotationMatrix[2 i Pi/n].{circleCenters[[1, 1]], vertices[[1, 2]]}, {i, 0, n - 1}],
    Table[RotationMatrix[2 i Pi/n].{circleCenters[[-1, 1]], vertices[[-1, 2]]}, {i, 1, n}]
   };
   splineControlPoints = Flatten[Transpose[Insert[tangentPoints, vertices, 2]], 1];
   FilledCurve@BSplineCurve[splineControlPoints, SplineClosed -> True]
]

Here's the obligatory animation :-)

Animate[
 Graphics[
  {EdgeForm[{Thickness[0.01], Black}], FaceForm[Darker@Green], 
   splineRoundedNgon[5, radius]}
 ],
 {{radius, 0, "Rounding\nradius"}, 0, 1}
]

animation of rounding

And here is an example of a discretized region obtained from it:

DiscretizeGraphics[splineRoundedNgon[5, 0.3], MaxCellMeasure -> 0.001]

discretized region

Such regions can be used e.g. as domains for plotting and in NDSolve calculations. For instance:

Plot3D[
  y Sin[5 x] + x Cos[7 y], {x, y} ∈ DiscretizeGraphics@splineRoundedNgon[5, 0.4]
]

plot using region as domain


You can also create a spline curve to get a bit more roundness in the corners than allowed by JoinedForm. You need to double each control point in your spline definition to have the spline "hug" the points more closely. This is conveniently wrapped up in the roundRegPoly helper function below:

Clear[roundRegPoly]
roundRegPoly[n_Integer /; n >= 3] :=
 FilledCurve@BSplineCurve[
   Flatten[#, 1] &@Transpose[{#, #}] &@CirclePoints[n],
   SplineClosed -> True
 ]

Graphics[
  {Darker@Green, EdgeForm[{Thickness[0.01], Black}], roundRegPoly[5]},
  PlotRangePadding -> Scaled[.1]
]

Mathematica graphics

| improve this answer | |
$\endgroup$
  • $\begingroup$ This is an excellent result. $+1$ upvote. I would also like to ask, as per my comment to C. E, how I would go about actually telling Mathematica that this is the domain that I want to work with for NDSolve. I'm ideally hoping to specify the above rounded pentagon as a domain $D$. In other words, I want to write $D= \cdots$. Usually I will write D=Polygon[...] but this won't work here. I apologise if this is a difficult question to ask. I've tried D = roundRegPoly[5] with no success. $\endgroup$ – Mr S 100 Mar 30 '16 at 23:37
  • $\begingroup$ @MrS100 Try using DiscretizeGraphics@roundRegPoly[5] as your region in NDSolve. It works as a plotting region: Plot3D[1, {x, y} ∈ DiscretizeGraphics[roundRegPoly[5], MaxCellMeasure -> 0.01]] returns this. $\endgroup$ – MarcoB Mar 30 '16 at 23:58
  • $\begingroup$ I'll give it a go now - thanks for the prompt response. I'll let you know the outcome $\endgroup$ – Mr S 100 Mar 31 '16 at 0:01
  • $\begingroup$ Works almost perfectly. The only flaw is that for some reason the bottom verticies of the polygon are not rounded. This is the case if I run Plot3D[1, {x, y} ∈ DiscretizeGraphics[roundRegPoly[5], MaxCellMeasure -> 0.01]]. In your image above the bottom corners are rounded so I wonder why this is happening. $\endgroup$ – Mr S 100 Mar 31 '16 at 0:04
  • $\begingroup$ @MrS100 That's odd. I am packing up to leave my office for the day, so I won't be able to test this immediately, but I'll look into it. $\endgroup$ – MarcoB Mar 31 '16 at 0:09
19
$\begingroup$

Just wanted to add purely mathematical approach using complex mapping technique.

 PolyMap[n_, z_] := z Hypergeometric2F1[1/n, 2/n, (n + 1)/n, z^n]
(* Integrate[1/(1 - ξ^n)^(2/n), {ξ, 0, z}] *) 

g = GraphicsGrid[
Table[
 ParametricPlot[
  z = PolyMap[n, r (Cos[t] + I Sin[t])]; {Re[z], Im[z]}, 
   {t, 0, 2 π}, PlotRange -> All, Axes -> False] /. 
   Line[l_List] :> {{Lighter[ColorData[3, "ColorList"][[n]]], Polygon[l]}, {Red, Thick, Line[l]}}, 
 {n, 3, 8}, {r, 0.799, 1., 0.1}], 
ImageSize -> 400]

some examples

| improve this answer | |
$\endgroup$
  • $\begingroup$ This is excellent $+1$ upvote! $\endgroup$ – Mr S 100 Mar 31 '16 at 10:34
  • $\begingroup$ For those who are a bit mystified as to how this works, look up the Schwarz–Christoffel mapping. $\endgroup$ – J. M.'s technical difficulties Apr 2 '16 at 0:18
  • $\begingroup$ That's strange: so many upvotes but I get errors instead of the output with version 10.4 on Win7 x64: screenshot. Are you sure you have no mistakes in the code? $\endgroup$ – Alexey Popkov Apr 4 '16 at 18:28
  • $\begingroup$ @AlexeyPopkov Thank you for testing the code. Mysteriously one comma disappear when editing... Now the code is corrected! $\endgroup$ – yarchik Apr 4 '16 at 18:37
  • $\begingroup$ Now it works, thank you. +1 $\endgroup$ – Alexey Popkov Apr 4 '16 at 18:39
17
$\begingroup$

Since you mention that you want to use the rounded polygon in NDSolve[] as a region, you might want to look at the following construction:

With[{r = 1/5 (* rounding radius *)}, 
     rp = DiscretizeRegion[
          ImplicitRegion[RegionDistance[
          Polygon[CirclePoints[{1 - 2 Sqrt[5 - 2 Sqrt[5]] r, π/10}, 5]], {x, y}] <=
          r Sqrt[(5 - Sqrt[5])/2], {x, y}], MaxCellMeasure -> 1/200]];

Graphics[{{Yellow, Polygon[CirclePoints[{1, π/10}, 5]]},
          {Opacity[2/3, Blue], MeshPrimitives[rp, 2]}}]

pentagon and its discretized rounded version

Rescale/rotate/translate as needed.

| improve this answer | |
$\endgroup$
  • $\begingroup$ I really like this solution. It is exceptionally well done. $+1$ upvote! $\endgroup$ – Mr S 100 Mar 31 '16 at 10:37
  • 1
    $\begingroup$ You can also use BoundaryDiscretizeRegion and even get just a single Polygon with by applying MeshPrimitives[#, 2] & to the discretized region. $\endgroup$ – kirma Mar 31 '16 at 15:08
  • $\begingroup$ @kirma, I'll edit that in later, but on the other hand, for a single polygon with rounded corners, I won't even need the fancy region functionality. I can fall back on a little trig for that one. ;) $\endgroup$ – J. M.'s technical difficulties Mar 31 '16 at 15:15
  • $\begingroup$ @J.M. Using "fancy region functionality" may sometimes be easier than thinking of trigonometry, though... ;) $\endgroup$ – kirma Mar 31 '16 at 15:22
15
$\begingroup$

FilledCurve will do the job because it can be styled by JoinForm:

Graphics[{
  EdgeForm[{JoinForm["Round"], Thickness[0.05]}],
  FilledCurve[Line /@ Partition[CirclePoints[5], 2, 2, 1]]
  }, PlotRange -> 1.2]

Mathematica graphics

MarcoB found that this simpler version also works (see comments):

Graphics[{
  EdgeForm[{JoinForm["Round"], Thickness[0.05]}],
  FilledCurve[Line@CirclePoints[5]]
  }, PlotRange -> 1.2]

I also made a version where I combined a polygon with a list element but the list manipulation required is rather inelegant. It looks like this:

coords = ArrayPad[CirclePoints[5], {{0, 1}, {0, 0}}, "Periodic"];
coords = ArrayPad[coords, {{1, 1}, {0, 0}}, Mean[{coords[[1]], coords[[2]]}]];
Graphics[{
  Polygon[coords],
  JoinForm["Round"], Thickness[0.05],
  Line[coords]
  }]
| improve this answer | |
$\endgroup$
  • $\begingroup$ Note that Line@CirclePoints[5] will work as well, instead of your partition expression (+1). $\endgroup$ – MarcoB Mar 30 '16 at 22:37
  • $\begingroup$ @MarcoB Actually you have to manipulate the coordinates to make that work, otherwise you will have one corner that is not rounded because the end will not be joined to the start by itself. I added my code for this to the end of my answer. $\endgroup$ – C. E. Mar 30 '16 at 22:41
  • 1
    $\begingroup$ I think I wasn't clear: I meant to say that Graphics[{EdgeForm[{JoinForm["Round"], Thickness[0.05]}], FilledCurve[Line@CirclePoints[5]]}, PlotRangePadding -> Scaled[.1]] should work too. This is the output I get on 10.4, which seems to me to have all corners rounded. $\endgroup$ – MarcoB Mar 30 '16 at 22:44
  • $\begingroup$ @MarcoB Actually I see now that you wrote "instead of...". I was so wrapped up in my thinking that I missed that part of the sentence/jumped to my conclusion. $\endgroup$ – C. E. Mar 30 '16 at 22:49
  • 1
    $\begingroup$ J. M. solved it, as you have seen :) $\endgroup$ – C. E. Mar 31 '16 at 12:24
15
$\begingroup$

Here is a more general method for producing polygons with rounded corners. Using a bit of vector algebra and trigonometry, I came up with the following:

arcgen[{p1_, p2_, p3_}, r_, n_] :=
       Module[{dc = Normalize[p1 - p2] + Normalize[p3 - p2], cc, th}, 
              cc = p2 + r dc/EuclideanDistance[dc, Projection[dc, p1 - p2]];
              th = Sign[Det[PadRight[{p1, p2, p3}, {3, 3}, 1]]]
                   (π - VectorAngle[p3 - p2, p1 - p2])/(n - 1); 
              NestList[RotationTransform[th, cc],
                       p2 + Projection[cc - p2, p1 - p2], n - 1]]

roundedPolygon[Polygon[pts_?MatrixQ], r_?NumericQ, n : (_Integer?Positive) : 12] := 
               Polygon[Flatten[arcgen[#, r, n] & /@
               Partition[If[TrueQ[First[pts] == Last[pts]], Most, Identity][pts],
                         3, 1, {2, -2}], 1]]

Here, r is the rounding radius. and n controls the fineness of the component circle arcs. The resulting Polygon[] can then be fed into BoundaryDiscretizeRegion[] or DiscretizeRegion[] if needed.

Here is the OP's original case:

DiscretizeRegion[roundedPolygon[Polygon[N[CirclePoints[{1, π/10}, 5], 20]], 1/5]]

discretized rounded pentagon

A concave example:

star = N[Riffle[CirclePoints[{1, π/10}, 5],
                RotateLeft @ CirclePoints[{4 Sin[π/10]^2, -π/10}, 5]], 20];

DiscretizeRegion[roundedPolygon[Polygon[star], 1/8]]

rounded star

Use the rounded star as a domain:

Plot3D[Sin[6 x + Sin[6 y]], {x, y} ∈ roundedPolygon[Polygon[N[star, 20]], 1/8]]

wiggle my star

Compare the result of roundedPolygon[] with the built-in Rectangle[]:

{Graphics[roundedPolygon[Polygon[{{0, 0}, {4, 0}, {4, 2}, {0, 2}} // N], 1/2],
          Frame -> True], 
 Graphics[Rectangle[{0, 0}, {4, 2}, RoundingRadius -> 1/2], Frame -> True]} // GraphicsRow

two corner-filleted rectangles

As a final example demonstrating the flexibility of the routine, here is some Voronoi art:

BlockRandom[SeedRandom[42, Method -> "MersenneTwister"];
            pts = RandomReal[{-2, 2}, {50, 2}]];

BlockRandom[SeedRandom[42, Method -> "ExtendedCA"];
            Graphics[{Directive[ColorData[61, RandomInteger[{1, 9}]], EdgeForm[Gray]],
                      roundedPolygon[#, 1/8]} & /@ MeshPrimitives[VoronoiMesh[pts], 2]]]

rounded Voronoi tiles

| improve this answer | |
$\endgroup$
  • $\begingroup$ This is an excellent work of art. +1 $\endgroup$ – RunnyKine Apr 2 '16 at 0:25
  • $\begingroup$ @Runny, in that case, the time and paper spent deriving the required formulae were indeed well-spent. Thanks. :) $\endgroup$ – J. M.'s technical difficulties Apr 2 '16 at 0:30
  • $\begingroup$ I edited to include a missing comma in NestList that was preventing it from running properly. $\endgroup$ – RunnyKine Apr 2 '16 at 0:39
  • $\begingroup$ Huh, must've gotten removed while formatting. Thanks. $\endgroup$ – J. M.'s technical difficulties Apr 2 '16 at 0:43
  • $\begingroup$ $+1$ from me. This is excellent! I very much like the generalisation of this to non regular polygons. I have to say, I am very happy with the quality of the answers I have received for my question. Thank you for posting this solution! The result looks really good. $\endgroup$ – Mr S 100 Apr 2 '16 at 21:16

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.