4
$\begingroup$

I'm working on generating a random scribble I'm using the code provided by a Wolfram reference(which I can't link because of 10 rep limitation of two links). This produced well looking scribbles:

Graphics[{AbsoluteThickness[3], BezierCurve[RandomReal[1, {4, 2}]]}, Background -> None]

Scribble Example

However, when I try to generate a more complex scribble the next line won't be as smooth as the others:

Graphics[{AbsoluteThickness[3], BezierCurve[RandomReal[1, {5, 2}]]}, Background -> None]

Scribble Example

I experience the same issue when the code is expanded to 6 points(I'd link the image but I can only post 2 images because I have less than 10 reputation). How can I make these scribbles look more natural for more than 4 points? I am aware this can be a mathematics consequence of a Bezier parametric function itself, if that's the case, is there any other way to generate natural smooth scribbles with Mathematica? Thanks.

$\endgroup$
4
  • 1
    $\begingroup$ Try BezierCurve[RandomReal[1, {5, 2}], SplineDegree -> 4] per the docs. If you want smooth, then the degree should be one less than the number of points. $\endgroup$
    – Michael E2
    May 8, 2017 at 2:24
  • 2
    $\begingroup$ There's also BSplineCurve and the spline method of Interpolation: xIF = Interpolation[RandomReal[10, 23], Method -> "Spline"]; yIF = Interpolation[RandomReal[10, 23], Method -> "Spline"]; ParametricPlot[{xIF[t], yIF[t]}, {t, 1, 23}] $\endgroup$
    – Michael E2
    May 8, 2017 at 2:30
  • $\begingroup$ Try Graphics[{AbsoluteThickness[3], BezierCurve[Sort@RandomReal[1, {5, 2}]]}, Background -> None] $\endgroup$
    – ZaMoC
    May 8, 2017 at 2:45
  • $\begingroup$ @MichaelE2 your first line of code works pretty well, thanks! $\endgroup$ May 8, 2017 at 2:52

3 Answers 3

2
$\begingroup$

I think the problem you are having may have to do with the order of the random points... when random, the line wants to zig and zag back and forth. One way around this would be to pick a good order to visit the random points. For example, FindShortestTour finds a good way to traverse the points.

n = 20; 
{d, order} = FindShortestTour[r = RandomReal[1, {n, 2}]]; 
Graphics[{AbsoluteThickness[3], BezierCurve[r[[Rest[order]]]]},
    Background -> None]

enter image description here

$\endgroup$
3
  • 1
    $\begingroup$ While this a good solution to get random scribbles without overlapping(which reduced a little bit the randomness of it), when n = 5 I still get a "hard" line. $\endgroup$ May 8, 2017 at 3:03
  • 1
    $\begingroup$ Bezier curves have sharp curves -- they are not smooth. So there is no reason to expect a randomly chosen curve to be smooth! $\endgroup$
    – bill s
    May 8, 2017 at 3:10
  • $\begingroup$ The only way to smooth it is by using Michael's code: BezierCurve[RandomReal[1, {5, 2}], SplineDegree -> 4] ? Just for curiosity: The 5th point always gonna be produce a sharp curve? That seems to happen to me. I don't understand all the math behind it. $\endgroup$ May 8, 2017 at 3:14
4
$\begingroup$

You can sort these random points
here is the unsorted (red line) and the sorted (black) for 15 points

r = RandomReal[{-5, 5}, {15, 2}];
Graphics[{AbsoluteThickness[3], BezierCurve[Sort@r], Red, 
AbsoluteThickness[3], BezierCurve[r]}, Background -> None]

enter image description here

$\endgroup$
1
  • $\begingroup$ Similarly to bill's answer, while this a very nice approach to get random scribbles without overlapping lines, when n = 5 I still get a "hard" line. Michael's comment in my question solved well the "hard" line issue. $\endgroup$ May 8, 2017 at 3:05
4
$\begingroup$

I'm using the code provided by a Wolfram reference(which I can't link because of 10 rep limitation of two links). This produced well looking scribbles:

There is a resource function RandomScribble. Here is a demo:

SeedRandom[125]; 
Grid[
 Table[ResourceFunction["RandomScribble"]["NumberOfStrokes" -> ns, ColorFunction -> cf, PlotStyle -> AbsoluteThickness[2]], 
       {cf, {"Rainbow", GrayLevel}}, 
       {ns, {120, {200, 120}, {120, 300, 32}}}], 
 Dividers -> All, FrameStyle -> Gray]

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.