Generating a random scribble using BezierCurve won't smooth in 5th point

Question

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]

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]

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.

bill s · Accepted Answer

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]

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

J42161217 · Answer

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]

Anton Antonov · Answer

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]

Generating a random scribble using BezierCurve won't smooth in 5th point

3 Answers

Add your own answers!

Ask a Question