How to generate a random pulsar graph between two points?
After lots of trial an error I found a way to do this.
I created 3 functions.
Jaggify[list_, height_] :=
Union[Flatten[
Table[{list[[x]], {(list[[x, 1]] + list[[x + 1, 1]])/
2., (list[[x, 2]] + list[[x + 1, 2]])/2. +
height RandomReal[]^5}, list[[x + 1]]}, {x, 1,
Length[list] - 1}], 1]]
This function receives a list of points. Then it iterates over pair of points and adds a new one in between. The height of the new point is in the middle of the two adjacent points plus a random value.
RandomPulsarPoints[start_, end_, y_, peaks_, height_] :=
Module[{list, seedlist},
list = Table[{start + x, y}, {x, 0, end - start, (end - start)/
peaks}];
seedlist = Table[
{list[[linum, 1]],
list[[linum, 2]] +
If[linum == 1 || linum == 2 || linum == Length[list] - 1 ||
linum == Length[list]
, 0
, RandomChoice[{1/linum^3,
1 - 1/linum^3}-> {(height^3) RandomReal[],
height (RandomReal[])^3}]]}, {linum, 1, Length[list]}];
Join[{First[seedlist]},
Jaggify[Jaggify[Most[Rest[seedlist]], height],
height/2], {Last[seedlist]}]
]
This function generates a list of random points between start and end. The first two points and the last two have the same y value to force the graph to start and end smoothly. You can define how tall and how many peaks are there going to be in that interval.
pulsar[start_, end_, y_, height_, peaks_] :=
Module[{length = end - start},
If[length == 0 || peaks == 0, BSplineCurve[{{start, y}, {end, y}}],
BSplineCurve[RandomPulsarPoints[start, end, y, peaks, height]]]]
This final function just uses the previous functions to create a BSplineCurve
.
Graphics[pulsar[0, 10, 0, 3, 10]]
I hope this is useful to someone else. :)
One way to smooth things is to use an appropriate interpolating order with random points. The ends can be flattened out with the Hamming Window.
points = HammingWindow[Range[-0.7, 0.7, 0.1]] RandomReal[{0, 1}, 15];
Plot[Interpolation[points, InterpolationOrder -> 3][t], {t, 1, Length[points]}]