How to produce wavy lines

Question

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.

Answer 1

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}]

Addendum

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]

Answer 2

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.

Answer 3

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.sstatic.net/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

Answer 4

We can use resource function RandomScribble.

ResourceFunction["RandomScribble"][]