# Approximating an ornamental curve

How do I go about approximating this ornamental curve? Note variable thickness typical in calligraphy.

Handbook and Atlas of Curves by E.V. Shikin (1995) contains many directions, including curve families with singular points, but none that resemble this curve, and doesn't address variable thickness.

A single function describing the curve is desirable but piecewise definition and splines are acceptable.

-
I did a reverse image search on Google, I couldn't find the name of the design, but here are some more examples: goo.gl/N77lG – Guillochon Oct 21 '12 at 0:52
Cubic splines can represent each of the 4 loops, which can then be assembled. See demonstrations.wolfram.com/SimpleSplineCurves – DavidC Oct 21 '12 at 0:54
Nevermind, I found a font containing the symbol: ufonts.com/fonts/poetica-supp-ornaments.html – Guillochon Oct 21 '12 at 0:54
– R. M. Oct 21 '12 at 1:11
"This curve" is actually two curves. – Rahul Oct 21 '12 at 1:32

## Update

With the approach described in detail below and the function given by J. M. in his answer, we can additionally introduce points to the lines which vary randomly in their size. This gives the look and feel of a pen not drawing with constant thickness due to outrunning ink:

ParametricPlot[{{Cos[t] (2 + 7 Cos[2 t] - Cos[4 t])/8, Sin[t]^3 (3 - 2 Cos[2 t])/4},
3/2 {1, Cos[t]} Sin[t]/(1 + Cos[t]^2)}, {t, 0, 2 Pi},
Axes -> None, PlotRangePadding -> 0.1,
Background -> ColorData["Legacy", "Antique"], PlotStyle -> Black,
PlotPoints -> 500, MaxRecursion -> 0] /. Line[pts_] :>
(With[{thick = (Abs@
Sin[Mod[ArcTan @@ Subtract @@ # + 3/4 Pi,
2 Pi]])}, {PointSize[thick*0.035 + RandomReal[.007]],
Thickness[thick*.031 + 0.004], Line[#], Point[First[#]]}] & /@
Partition[pts, 2, 1])


This is far from being perfect, but considering the fact that we only used ParametricPlot and some transformation on the Lines, it looks quite nice.

In calligraphy the variation of the thickness comes from the fountain pen and it is related to how you hold it. In the simplest case, you don't change the angle of the pen in your hand during writing and then the thickness is only dependent on the direction of your line.

With this you have 3 parameters. First one is the base-thickness which is the thinnest line you can draw. Second, you have the max-thickness which is reached when you draw a line with the full width of your pen. When you keep your pen constant in your hand and you draw a circle, then thick and thin parts change smoothly. Let us try to implement this in Mathematica.

A curve in Mathematica is often just a set of many lines. If you have two points, which are connected through a line, you can calculate its direction with the help of ArcTan[x,y]. Since the ArcTan gives values between $[-\pi/2,\pi/2]$ we need to transform this a bit to get a smooth transition of angles in all directions.

In the following we extract the points from the Line[{p1,p2,p3,..}] directives and partition them in groups of two like {{p1,p2},{p2,p3},{p3,p4},..}. We calculate the angle of the first point to the second of every tuple and use this angle to adjust the thickness of every single line

p1 = ParametricPlot[{Cos[phi], Sin[phi]}, {phi, 0, 2 Pi}];
p1 /. Line[pts_] :>
({Thickness[(Abs@Sin[Mod[ArcTan @@ Subtract @@ #, 2 Pi]])*0.02], Line[#]} & /@
Partition[pts, 2, 1])


With your ornament you can do the same once you have found the formulas. Let me help you with the part of your curve which looks like $\infty$. This can easily expressed in parametric form

$$f(t) = \left\{2\cos\left(\frac{t}2\right), \sin(t)\right\}$$

infty = ParametricPlot[{2 Cos[1/2 t], Sin[t]}, {t, 0, 4 Pi}]


Now, following our approach from above and including it into a Manipulate we get:

Manipulate[
Show[infty /.
Line[pts_] :> ({Thickness[(Abs@Sin[
Mod[ArcTan @@ Subtract @@ # + direction, 2 Pi]])*
maxThickness + baseThickness], Line[#]} & /@
Partition[pts, 2, 1]),
PlotRange -> {{-3, 3}, {-2, 2}}, AspectRatio -> Automatic,
Axes -> False],
{direction, 0, 2 Pi},
{{baseThickness, 0.005}, 0, 0.02},
{{maxThickness, 1/50.}, 1/100., 1/30.}
]


-
Nice solution. For a pen held at fixed orientation, the thickness of the stroke should be proportional to $\lvert\sin\theta\rvert$ rather than $\sin\theta/2$ though. – Rahul Oct 21 '12 at 2:38
@RahulNarain Already fixed, thanks. – halirutan Oct 21 '12 at 2:46
The curve halirutan used here is the lemniscate of Gerono. – J. M. Oct 21 '12 at 4:11

As a starting point:

ParametricPlot[{
(* modified hypotrochoid *)
{Cos[t] (2 + 7 Cos[2 t] - Cos[4 t])/8, Sin[t]^3 (3 - 2 Cos[2 t])/4},
(* lemniscate of Bernoulli *)
3/2 {1, Cos[t]} Sin[t]/(1 + Cos[t]^2)},
{t, 0, 2 Pi}, Axes -> None, Background -> ColorData["Legacy", "Mint"],
PlotStyle -> Directive[ColorData["Legacy", "OliveDrab"],
AbsoluteThickness[3]]
]


Further styling (e.g. with halirutan's method) is left as an exercise to the reader.

-
I read that as "modified hypnotoad" o-0 – R. M. Oct 21 '12 at 5:37
@rm: damn, even you are not immune to the effects of your Gravatar... :D – J. M. Oct 21 '12 at 5:39

If you want to get complete command over the symbol and make it available to various types of geometrical transformations and text styling, you could use FilledCurve function. If splines work for you, FilledCurve may come handy too. If you have or will install the font Poetica Supp Ornaments mentioned in the comments by @Guillochon, then you could turn the character into a graphics:

text = First[First[ImportString[ExportString[Style["L",
FontFamily -> "Poetica"], "PDF"], "PDF"]]];


You can now do some styling with it

Graphics[{Gray, Translate[text, .5 {1, 1}], Red, text}, Frame -> True]


lst = Module[{l = Cases[text, FilledCurve[a__] :> {EdgeForm[Black], Darker[Red],