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

5 Answers 5

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

$\endgroup$
12
  • $\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
    Commented Mar 30, 2016 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
    Commented Mar 30, 2016 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
    Commented Mar 31, 2016 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
    Commented Mar 31, 2016 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
    Commented Mar 31, 2016 at 0:09
20
$\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

$\endgroup$
5
  • $\begingroup$ This is excellent $+1$ upvote! $\endgroup$
    – Mr S 100
    Commented Mar 31, 2016 at 10:34
  • $\begingroup$ For those who are a bit mystified as to how this works, look up the Schwarz–Christoffel mapping. $\endgroup$ Commented Apr 2, 2016 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$ Commented Apr 4, 2016 at 18:28
  • $\begingroup$ @AlexeyPopkov Thank you for testing the code. Mysteriously one comma disappear when editing... Now the code is corrected! $\endgroup$
    – yarchik
    Commented Apr 4, 2016 at 18:37
  • $\begingroup$ Now it works, thank you. +1 $\endgroup$ Commented Apr 4, 2016 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.

$\endgroup$
4
  • $\begingroup$ I really like this solution. It is exceptionally well done. $+1$ upvote! $\endgroup$
    – Mr S 100
    Commented Mar 31, 2016 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
    Commented Mar 31, 2016 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$ Commented Mar 31, 2016 at 15:15
  • $\begingroup$ @J.M. Using "fancy region functionality" may sometimes be easier than thinking of trigonometry, though... ;) $\endgroup$
    – kirma
    Commented Mar 31, 2016 at 15:22
16
$\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

$\endgroup$
8
  • $\begingroup$ This is an excellent work of art. +1 $\endgroup$
    – RunnyKine
    Commented Apr 2, 2016 at 0:25
  • $\begingroup$ @Runny, in that case, the time and paper spent deriving the required formulae were indeed well-spent. Thanks. :) $\endgroup$ Commented Apr 2, 2016 at 0:30
  • $\begingroup$ I edited to include a missing comma in NestList that was preventing it from running properly. $\endgroup$
    – RunnyKine
    Commented Apr 2, 2016 at 0:39
  • $\begingroup$ Huh, must've gotten removed while formatting. Thanks. $\endgroup$ Commented Apr 2, 2016 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
    Commented Apr 2, 2016 at 21:16
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]
  }]
$\endgroup$
6
  • $\begingroup$ Note that Line@CirclePoints[5] will work as well, instead of your partition expression (+1). $\endgroup$
    – MarcoB
    Commented Mar 30, 2016 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.
    Commented Mar 30, 2016 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
    Commented Mar 30, 2016 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.
    Commented Mar 30, 2016 at 22:49
  • 1
    $\begingroup$ J. M. solved it, as you have seen :) $\endgroup$
    – C. E.
    Commented Mar 31, 2016 at 12:24

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.