# How to produce wavy lines

New to Mathematica, I'd like to produce some 'thick wavy lines' as simple graphical forms (not sure how else to describe them), like the waved shape of this dagger blade (but not the handle):

I've searched https://demonstrations.wolfram.com/ > Art & Visual Patterns but couldn't find anything like that.

Are these shapes better off being created by other software?

The end result I'm after is to combine many of them to produce some splayed hair on a graphical portrait of a woman, something like this, in graphic form

Thoughts appreciated.

• Here's a way to vary thickness of a line/curve (for the dagger): mathematica.stackexchange.com/questions/28202/… -- hair texture seems a big ask and a big step from the dagger shape. If you want a silhouette or cartoonish graphics, maybe there's a better image to emulate. Otherwise it seems like these should be separate questions. Aug 6, 2023 at 14:12
• Are these shapes better off being created by other software? -- I hope so. The dagger blade has simple mathematical expressions for modeling the silhouette. Likewise for the twisted-rope handle. These aren't too hard in Mma. (Sans textures.) The hilt will exhaust most persons' patience. The hair is another matter altogether, as I said earlier. The closest thing to hair texture is given by LineIntegralConvolutionPlot, but I have no idea how to adapt it to hair that has overlaps etc. Aug 6, 2023 at 14:49
• @MichaelE2 I've updated my question for more clarity; I'd like to produce simpler graphical forms mimicking the dagger blade only Aug 12, 2023 at 14:04

You could try e.g. BSplineCurve or BezierCurve. Here is an example using BSplineCurve:

First we create some control points:

pts0 = Table[{i, (-1)^i}, {i, -3, 3}]; pts0 =
Join[{{-4, 0}}, pts0, {{4, 0}}]

{{-4, 0}, {-3, -1}, {-2, 1}, {-1, -1}, {0, 1}, {1, -1}, {2,
1}, {3, -1}, {4, 0}}


And then we create a Manipulate that lets you adapt the line to your needs:

Manipulate[Graphics[{BSplineCurve[pts]}, Frame -> True, PlotRange -> {5 {-1, 1}, 2 {-1, 1}}], {{pts, pts0}, Locator}]


And to export the graphis you could e.g. write:

Manipulate[gr=Graphics[{BSplineCurve[pts]}, Frame -> True, PlotRange -> {5 {-1, 1}, 2 {-1, 1}}], {{pts, pts0}, Locator}]

Export["d:/tmp/export.jpg", gr]

• Thank you, this is very helpful. If I run Export ["graphic", graphics, SVG] or Export ["graphic", graphics, GIF] there is an error Export::infer: Cannot infer format of file graphic. Aug 12, 2023 at 14:01
• I added an example how to export. Aug 12, 2023 at 16:10
• Using the command Export["c:\Temp\export.jpg", gr] there was a message "assuming a file name" and the file c:\Temp\export.jpg contained a small 14px x 15px JPG containing the characters gr. Aug 13, 2023 at 13:11
• Sorry I copied the wrong Manipulate that did not store the graphics.. The right is:  Manipulate[gr=Graphics[{BSplineCurve[pts]}, Frame -> True, PlotRange -> {5 {-1, 1}, 2 {-1, 1}}], {{pts, pts0}, Locator}]. And then, the file name must be a name on your PC.  Aug 13, 2023 at 14:44
• I've updated to Manipulate[gr = Graphics[{Thickness[0.05], BSplineCurve[pts]}, Frame -> True, PlotRange -> {5 {-1, 1}, 2 {-1, 1}}], {{pts, pts0}, Locator}]} and run Export["c:\Temp\export.jpg", gr] and receive a message Assuming a file name | Use as a generic text string instead & c:\Temp\export.jpg remains unchanged since 13/8/2023. Aug 19, 2023 at 12:53

# Plotting to Polygons

You can write equations to model curves. Trig functions like Sin are typical for waves. An envelope allows the wave to zigzag inside of another curve (in this case, something like the sword, $$\sqrt x$$).

Plot[{1.2 Sqrt[x], .8 Sqrt[x], -1.2 Sqrt[x], -.8 Sqrt[x]}, {x, 0, 50},
Filling -> {1 -> {2}, 3 -> {4}}](*envelopes*)
Plot[{
Sqrt[x] {1.2, .8}.{Sin[x]^2, 1},
-Sqrt[x] {1.2, .8}.{Sin[x + .5]^2, 1}}, {x, 0, 50},
Filling -> {1 -> {2}}](*curves*)
(*instead of Plot, we'll use Table with an increment*)
(*we have to reverse the lower curve, going left along the top and right along the bottom*)
Graphics[{Polygon@Join[#[[1]], Reverse@#[[2]]]}] &@
Transpose@Table[{
{x, Sqrt[x] {1.2, .8}.{Sin[x]^2, 1}},
{x, -Sqrt[x] {1.2, .8}.{Sin[x + .5]^2, 1}}},
{x, 0, 50, .1}](*making into Graphics primitives*)


Experimenting with curves and parameters may be easier in Desmos.

It's possible to transform instances of Polygons and overlay them on images. See Graphics for lots of examples.

Whatever you come up with, please post an answer along side this one. We can iterate.

## Procedure outline

1. Get an image with "wavy lines"
2. Import the image and extract edges representing the desired waves
• EdgeDetect is used below.
3. Extract the coordinates of the image pixels of the points that represent the edges
4. Approximate the edges using a fitting function (of five)
5. Plot the approximations
6. Tune fitting parameters, goto step 4, or declare success

## Computation steps

Get the image:

imgDagger = Import["https://i.stack.imgur.com/izoS6.jpg"]


Remove the background:

img1 = RemoveBackground[imgDagger, "Salient"]


Binarize the image and take "the blade part" of it:

img2 = ImageTake[Binarize[img1, 0.09], All, {10, ImageDimensions[img1][[1]]*3/5}]


Remark: Applying ColorNegate seems appropriate, but we get good results without it.

Remove the black spots inside the blade:

img3 = Dilation[img2, 1.2]


Edge detect and dilate:

img4 = Dilation[EdgeDetect[img3], 1.2]


Extract the edge points and plot them:

lsPoints = Reverse /@ Position[ImageData[img4], 1, 2];
ListPlot[lsPoints]


Separate the extracted points (one set for each dagger edge):

lsPoints2 = GatherBy[lsPoints, #[[2]] > 115 &];
ListPlot[lsPoints2]


Using FindFormula would have been nice if it worked:

fm = FindFormula[lsPoints2[[1]], TargetFunctions -> {Sin, Cos, Times, Plus}]


ListPlot[fm /@ Range @@ MinMax[Append[lsPoints2[[2]][[All, 1]], 5]]]


We can use Fit and NonLinearFit but then we have to think about appropriate models. It is much easier to use the resource function QuantileRegression. Here is an example:

qrFunc = First@ResourceFunction["QuantileRegression"][lsPoints2[[2]], 30, 0.5];
Show[ListPlot[lsPoints2[[2]], PlotStyle -> Gray], Plot[qrFunc[x], {x, 0, 500}, PlotStyle -> Red]]


Let us introduce random noise into the dagger-upper-edge points and then find and plot the fitted curves a few times (or five):

lsPoints3 = SortBy[lsPoints2[[2]], First][[1 ;; -1 ;; 3]];
lsQRFuncs = Table[First@ResourceFunction["QuantileRegression"][lsPoints3 + RandomVariate[NormalDistribution[0, 8], Length[lsPoints3]], 30, 0.5], 5];
lsQRFuncs = Map[PiecewiseExpand[#[x]] &, lsQRFuncs];
Show[ListPlot[lsPoints2[[2]], PlotStyle -> GrayLevel[0.7]], Plot[lsQRFuncs, {x, 0, 500}, PlotStyle -> Directive[{AbsoluteThickness[3]}], PerformanceGoal -> "Speed", PlotTheme -> "Scientific", AspectRatio -> 1/3]]


Plot each of the obtained lines separately:

Map[Plot[#, {x, 0, 500}, PlotStyle -> Directive[{Red, AbsoluteThickness[2]}], AspectRatio -> 1/3, PerformanceGoal -> "Speed", PlotTheme -> "Web"] &, lsQRFuncs]


Remark: The wavy curves can be "tuned" by using different number of knots and different random noise distributions

We can use resource function RandomScribble.

ResourceFunction["RandomScribble"][]
`