4
$\begingroup$

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):

enter image description here

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

enter image description here

Thoughts appreciated.

$\endgroup$
3
  • 2
    $\begingroup$ 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. $\endgroup$
    – Michael E2
    Aug 6, 2023 at 14:12
  • 4
    $\begingroup$ 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. $\endgroup$
    – Michael E2
    Aug 6, 2023 at 14:49
  • $\begingroup$ @MichaelE2 I've updated my question for more clarity; I'd like to produce simpler graphical forms mimicking the dagger blade only $\endgroup$
    – Steve
    Aug 12, 2023 at 14:04

4 Answers 4

7
$\begingroup$

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

enter image description here

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]
$\endgroup$
23
  • $\begingroup$ 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. $\endgroup$
    – Steve
    Aug 12, 2023 at 14:01
  • 1
    $\begingroup$ I added an example how to export. $\endgroup$ Aug 12, 2023 at 16:10
  • $\begingroup$ 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. $\endgroup$
    – Steve
    Aug 13, 2023 at 13:11
  • $\begingroup$ 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. $\endgroup$ Aug 13, 2023 at 14:44
  • $\begingroup$ 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. $\endgroup$
    – Steve
    Aug 19, 2023 at 12:53
6
$\begingroup$

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.

$\endgroup$
4
$\begingroup$

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

enter image description here

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

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

enter image description here

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

Remove the black spots inside the blade:

img3 = Dilation[img2, 1.2]

enter image description here

Edge detect and dilate:

img4 = Dilation[EdgeDetect[img3], 1.2]

enter image description here

Extract the edge points and plot them:

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

enter image description here

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

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

enter image description here

Using FindFormula would have been nice if it worked:

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

enter image description here

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

enter image description here

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

enter image description here

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]

enter image description here

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

$\endgroup$
0
1
$\begingroup$

We can use resource function RandomScribble.

ResourceFunction["RandomScribble"][]

enter image description here

$\endgroup$

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.