Plotting S-i-R data

Review of the basics

Here's the list-making code from Part One:

Clear[t];
Clear[tinitial];
Clear[tfinal];
Clear[numberofsteps];
Clear[S];
Clear[i];
Clear[R];
Clear[deltat];
Clear[datapoints];
datapoints = {};
S =45400;
i = 2100;
R = 2500;
tinitial=0;
tfinal = 5;
t = tinitial;
numberofsteps = 50;
deltat = (tfinal- tinitial)/numberofsteps;
For[k=1,k≤numberofsteps,
Sprime = -.00001*S*i; 
iprime =.00001*S*i - i/14; 
Rprime = i/14; 
deltaS = Sprime*deltat; 
deltai = iprime*deltat; 
deltaR = Rprime*deltat; 
t=t+deltat; 
S = S+deltaS; 
i = i + deltai; 
R = R+deltaR;
datapoints =Append[datapoints, {t,S,i,R}]; k++]

Here are the plotting commands from Part One:

ListPlot[Table[{datapoints[[j,1]],datapoints[[j,2]]}, {j,1, Length[datapoints]}]]

ListPlot[Table[{datapoints[[i,1]],datapoints[[i,2]]},{i,1,Length[datapoints]}],Joined->True]

Making the code a bit simpler

Okay, but that's hard to read.  Let's do this, instead:

Sdata = Table[{datapoints[[i,1]],datapoints[[i,2]]},{i,1, Length[datapoints]}];
idata = Table[{datapoints[[i,1]],datapoints[[i,3]]},{i,1, Length[datapoints]}];
Rdata = Table[{datapoints[[i,1]],datapoints[[i,4]]},{i,1, Length[datapoints]}];

Now we can do a ListPlot command which is easier to parse.

ListPlot[Sdata]

Showing different functions on the same axes

Let's suppose we want to look at S, i, and R all at the same time, on the same axes.  The thing is that they all have different ranges... We could just tell Mathematica to plot them and see what happens...

ListPlot[{Sdata, idata,Rdata}]

Wanna see it again, but slower?

Yes, this sounds sort of crazy at first.  But what if you want to see the approximation happen in front of your eyes?  That is, what if you want to watch each data point appear in sequence?  Mathematica actually has a pretty simple way of doing this (though you'll notice that we have to go back to the more-verbose code to do it).  We'll start by just animating the Sdata plot.

Animate[ ListPlot[Table[{datapoints[[i,1]],datapoints[[i,2]]},{i,1,k}],PlotRange->{{0,5},{30000,45400}}],{k,1, Length[datapoints]}]

Here's what's going on.  Just as one might expect, Mathematica is generating a sequence of graphs and showing them to us.  So we have to tell it to draw only the first k points of the data, and then let this process range over datapoints.  The way we do it is to take our original Table command and place it inside Animate, with one iterator (i going from 1 to k) for Table and another (k going from 1 to Length[datapoints] ) for Animate.  We also have to add the PlotRange option to ListPlot, or else Mathematica will automatically resize the graphs as it draws them (cool looking, but not very easy to read).  Notice that PlotRange takes an ordered pair of ordered pairs, where the first ordered pair is the x-range and the second ordered pair is the y-range.

Okay.  Let's do S, i, and R...all at the same time...

Animate[ ListPlot[{Table[{datapoints[[i,1]],datapoints[[i,2]]},{i,1,k}],Table[{datapoints[[i,1]],datapoints[[i,3]]},{i,1,k}],Table[{datapoints[[i,1]],datapoints[[i,4]]},{i,1,k}]},PlotRange->{{0,5},{0,45000}}],{k,1, Length[datapoints]}]

Plotting a whole pile of approximations, all at once

One way to do this is as follows.
(1) For each approximation you want to plot, run the program at the top of this notebook---but in addition to changing the number of steps, change datapoints to some other name each time, like datapoints1, datapoints2, etc.  You'll need to change it in four places each time  you do it.
(2) Pull out the S data (or the i data or the R data) from each one, using the Table command given above, but again changing Sdata (and/or idata and/or Rdata) to other names each time like Sdata1, Sdata2, etc.
(3) Use the Show command, as below, to put it all together.

Show[ListPlot[Sdata1,Joined->True],ListPlot[Sdata2],ListPlot[Sdata3]]

If you can't see the difference between the different lines on the combined plot, then try zooming in with the PlotRange option:

Show[ListPlot[Sdata1,Joined->True],ListPlot[Sdata2],ListPlot[Sdata3],PlotRange->{{0.6`,1},{44400,44800}}]

Yes, there is a way to do this all in one step (or two steps) in Mathematica.  It requires generating your datapoints file in a clever way, and then pulling various parts of it out.  The following example is for only one differential equation:

tinitial = 0;
tfinal = (something);
yinitial = (something);
datapoints = {};
 For[j = 1, j <= 10, numberofsteps = 2^(j);
    t = tinitial;
    y = yinitial;
    deltat = (tfinal - tinitial)/numberofsteps;
      For[k = 1, k <= numberofsteps, (stuff);
    datapoints = Append[datapoints, {t, y}];
    t = t + deltat; y = y + deltay, k++];
j++]

Notice what's going on in this code:
(1) There's a second For loop around the old For loop.
(2) Inside the outer For but outside the inner For, the loop starts over with the starting t and y.
(3) There's one big list, and 10 different parts of it are plotted. 

I wouldn't recommend running this with j going to more than 10, because 2^10 steps is almost always more than you need already. Now, so far we've only generated the data.  Let's plot it (or more correctly, let's Animate it):

Animate[ListPlot[Table[{datapoints[[i,1]],datapoints[[i,2]]},{i,Sum[2^k,{k,0,j-1}],Sum[2^k,{k,0,j}]-1}],Joined->True,PlotRange->{{0,40},{0,45000}}],{j,1,10,1}]

Those crazy Sums are in there to make sure the correct points are pulled out for each frame in the animation.  And, the PlotRange was chosen to match the standard S - i - R model; it' ll need to be changed to match whatever differential equation(s) you' re using.

Now, let' s face it:  You can't always send someone a Mathematica file.  Sometimes you need to show all of the approximations at once, on one set of axes, so you can print it out.  Here's how to do that.

ListPlot[Table[Table[{datapoints[[i,1]],datapoints[[i,2]]},{i,Sum[2^k,{k,0,j-1}],Sum[2^k,{k,0,j}]-1}],
{j,1,10,1}],
Joined->True,PlotRange->{{0,40},{0,1000}}]

Adding flashy stuff like color and labels and mouseovers and legends

When we showed S, i, and R all one one set of axes, you might have noticed that Mathematica automatically used three different colors for the three different data sets.  Sometimes it picks colors that are hard to distinguish, in which case you'll want to add your own colors.   Check this out:

ListPlot[{Sdata,idata,Rdata},Joined->True]

The colors look different because the lines are thinner.  Let's make those colors different.  The deal there is that you specify a list of colors in PlotStyle, where the first one of the three RGB coordinates is red, the second green, and the third blue.  (So RGB[1, 0, 1] is a purple. Another purple is RGB[.5,0,.5]...)  Notice that the colors are assigned in the same order as the datasets are listed.

ListPlot[{Sdata,idata,Rdata},Joined->True, PlotStyle -> {RGBColor[1,0,0],RGBColor[0,1,0],RGBColor[0,0,1]} ]

Oh, you want labels?  Just add another option, PlotLabel.

ListPlot[{Sdata,idata,Rdata},Joined->True, PlotStyle -> {RGBColor[1,0,0],RGBColor[0,1,0],RGBColor[0,0,1]}, PlotLabel ->"S (red), i (green), R(blue)" ]

We can get fancier...

ListPlot[{Sdata,idata,Rdata},Joined->True, PlotStyle -> {RGBColor[1,0,0],RGBColor[0,1,0],RGBColor[0,0,1]}, PlotLabel ->Framed[{Style["Susceptibles",Red], Style["infecteds",Green], Style["Recovereds",Blue]}] ]

and fancier...

ListPlot[Tooltip[{Sdata,idata,Rdata}],Joined->True, PlotLabel ->"Susceptibles, infected, Recovereds: data points on mouseover"]

...and if you want to get even fancier, investigate PlotLabel in the Document Center.  (You can get pretty darn fancy with this.)

Now let's suppose that you only have a greyscale printer (not an unreasonable supposition), so you want to distinguish these graphs in a printout.  We'll use a different setting in PlotStyle to get dashes instead of colors.

ListPlot[{Sdata,idata,Rdata},Joined->True, PlotStyle -> {GrayLevel[0], Dashing[{.015}], Dashing[{.03}]}, PlotLabel ->Framed["Susceptibles (solid), infecteds (short dash), Recovereds (long dash)" ]]