6
$\begingroup$

I want to make a program that produces images like this one

enter image description here

What I have tried...

ListLinePlot[
Table[Join[Table[2 RandomReal[], 15], 
Accumulate[RandomChoice[Range[-20, 20], 20]], 
Table[2 RandomReal[], 15]] + k, {k, 1, 300, 10}], 
PlotStyle -> 
Directive[RGBColor[1., 1., 1.], Opacity[1.], 
AbsoluteThickness[1.015]], Axes -> False, Background -> Black]    

this code returns random images like the following

enter image description here

as you can see every line must cover the line(s) above it.
I tried Filling and FillingStyle but I can't make it work. How can I accomplish this?

You don't have to use my code.
Make your own if it is easier for you..

$\endgroup$
  • 4
    $\begingroup$ intothecontinuum.tumblr.com/post/27443100682/… $\endgroup$ – Kuba Nov 2 '18 at 23:01
  • $\begingroup$ nice! but I think that it would be better without Sin curves. Any ideas on how to make something very similar to the first pic I posted? $\endgroup$ – J42161217 Nov 2 '18 at 23:08
  • $\begingroup$ Search for "pulsar" and few related topic will appear. $\endgroup$ – Kuba Nov 2 '18 at 23:18
  • $\begingroup$ @Kuba I don't have a problem making a pulsar like img. My problem which is about plotting in Mathematica is how to make the upper lines disappear. It has nothing to do with pulsars or if you like joy division.. $\endgroup$ – J42161217 Nov 2 '18 at 23:26
  • 1
    $\begingroup$ I didn't mean google but se. mathematica.stackexchange.com/search?q=pulsar $\endgroup$ – Kuba Nov 2 '18 at 23:33
4
$\begingroup$

It seems that the lines are shown through the axis filling if you plot all the data series in one plot. The solution to that is to plot them separately and then combine them using Show. The second problem is that we have to plot the upper ones before the lower ones since the lower ones are supposed to overlap the upper ones and not vice-versa. For that I used {k, 300, 1, -10} instead of {k, 1, 300, 10}. The code now looks like this:

data = Table[
   Join[Table[2 RandomReal[], 15], 
     Accumulate[RandomChoice[Range[-20, 20], 20]], 
     Table[2 RandomReal[], 15]] + k, {k, 300, 1, -10}];

Show[ListLinePlot[
    #,
    PlotStyle -> 
     Directive[RGBColor[1., 1., 1.], Opacity[1.], 
      AbsoluteThickness[1.015]],
    Axes -> False,
    Background -> Black,
    Filling -> Axis,
    FillingStyle -> Black,
    PlotRange -> {{0, 50}, {0, 400}}
    ] & /@ data]

Mathematica graphics

And if you're wondering how I found the plot range, I simply plotted all the data in one plot first and took notice of what the plot range seemed to be and wrote that down.

$\endgroup$
  • 1
    $\begingroup$ this is very nice. thank you $\endgroup$ – J42161217 Nov 2 '18 at 23:42
  • $\begingroup$ PlotRange -> {{-20, 70}, {-70, 400}} gives a better result ;-) $\endgroup$ – J42161217 Nov 2 '18 at 23:54
6
$\begingroup$

We've lost control... again

enter image description here

Transpose@Table[{x, y + 3 Exp[-((x - Sin[y/5])/3)^2] (.5 + RandomReal[{-.2, 1}])}, {x, -8, 8, .5}, {y, 0, 50}] // Short
Show[ListPlot[#, Joined -> True, Filling -> Bottom, FillingStyle -> Black, PlotStyle -> {Thin, White}, Background -> Black, PlotRange -> {{-15, 15}, {-10, 60}}, Axes -> False, ImageSize -> Large] & /@ Reverse@%, AspectRatio -> 1]
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.