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.
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.}
]
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]
or advanced transformations and morphing:
lst = Module[{l = Cases[text, FilledCurve[a__] :> {EdgeForm[Black], Darker[Red],
FilledCurve[a]}, Infinity]}, Table[Graphics[{l /. {x_Real, y_Real} :>
{x 6 Cos[x/12 + t], y 6 Sin[x/12 + t]}}, Frame -> False, PlotRange -> All,
ImageSize -> {400, 400}], {t, 0, 2 \[Pi], .1}]];
Export["L.gif", lst]
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.