23
$\begingroup$

I'd like to be able to better mimic the graphics at earth.nullschool.net using Mathematica and I'm looking for suggestions for either improving my code or getting directed to some other approach.

Below is code to create an animated gif that shows the StreamPlot of {-1 - x^2 + y, 1 + x - y^2}.

(* Set appearance of line segments in stream lines *)
(* Line segment plus blank space length *)
s = 0.25;
(* Number of shifts - larger integer values of k result in smoother transitions *)
k = 5;
(* Ratio of line segment length to blank space length *)
ratio = 20;
(* Maximum number of line seqments expected in a single stream line *)
maxSegments = 20;
(* Number of figures to create: n0 leading with a space and n1 leading with a line segment *)
n0 = k
n1 = k*ratio

delta = s/(n0 + n1) (* Amount of shift for each segment *)
s0 = s n0/(n0 + n1) (* Length of blank space *)
s1 = s n1/(n0 + n1) (* Length of line segment *)

(* Figures with stream lines leading with a line segment *)
g1 = Table[
   StreamPlot[{-1 - x^2 + y, 1 + x - y^2}, {x, -3, 3}, {y, -3, 3},
    StreamScale -> {Flatten[{{j delta, s0}, Table[{s1, s0}, {i, maxSegments}]}], 0, 0.0001},
    ImageSize -> Medium],
   {j, 1, n1}];
(* Figures with stream lines leading with a blank space *)
g0 = Table[
   StreamPlot[{-1 - x^2 + y, 1 + x - y^2}, {x, -3, 3}, {y, -3, 3},
    StreamScale -> {Flatten[{{0, j delta}, Table[{s1, s0}, {i, maxSegments}]}], 0, 0.0001},
    ImageSize -> Medium],
   {j, 1, n0}];
(* Combine figures *)
g = Flatten[{g0, g1}];

(* Export to an animated gif *)
Export["StreamPlot.gif", g]

Stream plot

I suspect I'll need to make a series of random starts for the stream lines to make it look less klunky but if there's another way to go about this, I'd appreciate learning about that.

$\endgroup$
29
$\begingroup$

I think you might be better off creating Graphics directly instead of using the StreamPlot style options. In this example I use StreamPlot just once and extract the coordinates of the arrows, which I use to create Line objects with VertexColors. The animation is made by cycling the vertex colors.

plot = StreamPlot[{-1 - x^2 + y, 1 + x - y^2}, {x, -3, 3}, {y, -3, 3}];

splines = Cases[plot, Arrow[data_] :> BSplineFunction[data], -1];

r = Range[0, 1, 0.05];

cols = Opacity[#, White] & /@ r;

lines[i_] := Map[Line[# /@ r, VertexColors -> RotateRight[cols, i]] &, splines]

frames = Table[
   Graphics[{Thickness[0.005], CapForm["Round"], lines[i]}, Background -> Lighter@Blue], 
   {i, Length@r}];

Export["test.gif", frames]

enter image description here

$\endgroup$
  • $\begingroup$ Is there a way to add 1) add color based on on the four quadrants, that is, when trajectories start in particular quadrant, they are a unique color? Choose an initial starting point and make that one a different color? $\endgroup$ – Moo Jul 16 '16 at 14:33
  • $\begingroup$ @Moo, you could change the colors by using different cols for each line, but note that the individual lines are rather short, so the colors won't propagate along the whole stream line. $\endgroup$ – Simon Woods Jul 16 '16 at 20:21
  • $\begingroup$ Excellent! Thank you! $\endgroup$ – JimB Jul 18 '16 at 17:04
17
$\begingroup$

I would like provide an alternative answer using the method of Simon Woods to extract the contour lines. However, in contrast to his approach I prefer to have them as long as possible. This is achieved by the StreamScale -> Full option.

nlines = 30;
flist = {-1 - x^2 + y, 1 + x - y^2};
xmn = -3;
xmx = 3;
ymn = -3;
ymx = 3;
subint = 3;
plot = StreamPlot[flist, {x, xmn, xmx}, {y, ymn, ymx}, 
   StreamScale -> Full, StreamPoints -> nlines];
p2 = DensityPlot[Norm[flist], {x, xmn, xmx}, {y, ymn, ymx}, 
   ColorFunction -> "DeepSeaColors"];
splines = Cases[plot, Arrow[data_] :> BSplineFunction[data], -1];
len = Length[splines];
t0 = RandomReal[{0, 1}, len];
frames = Table[
   Show[p2, {Table[
      ParametricPlot[splines[[i]][t], {t, 0, 1}, 
       ColorFunction -> 
        Function[{x, y, u}, 
         Blend[{Opacity[0.0, Black], Opacity[0.0, Black], 
           Opacity[0.1, Red], Lighter[Cyan], White}, 
          Mod[subint (u - k) + t0[[i]], 1]]], Axes -> False], {i, 
       len}]}], {k, 0, 1, 0.01}];

enter image description here

Another example

nlines = 20;
flist = {y, -y + x - x^3};
xmn = -2;
xmx = 2;
ymn = -2;
ymx = 2;
subint = 5;

enter image description here

Thus, distinct features of my approach are:

  1. Use of StreamScale -> Full;

  2. Background through DensityPlot;

  3. Randomization of initial times t0 = RandomReal[{0, 1}, len];

  4. Lines' colours blending, here the number of choices is really limited by your phantasy only.

But what are the differences compared to the original animation? Much larger number of contours in the OP is the major distinction. I guess, MA approach would be only feasible for small maps, for larger ones a compilation might be needed.

$\endgroup$
  • $\begingroup$ Very nice! I especially like the randomization of the initial times. $\endgroup$ – JimB Jul 19 '16 at 19:14

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.