Population Growth

Here is the actual data that represents the world's population (the semicolon at the end tells Mathematica not to print an output for this input):

data1  =  { {1900, 1650}, {1910, 1750}, {1920, 1860}, {1930, 
            2070}, {1940, 2300}, {1950, 2520}, {1960, 3020}, {1970, 
            3700}, {1980, 4450}, {1990, 5300}, {1996, 5770}};

To actually use this data, however, we have to pick a t=0 and define t as the time from that date. So let's pick 1990 as the initial time, and t will measure years from that date:

data2  =  { {0, 1650}, {10, 1750}, {20, 1860}, {30, 2070}, {40, 
            2300}, {50, 2520}, {60, 3020}, {70, 3700}, {80, 4450}, {90, 
            5300}, {96, 5770}};

It is always a wise idea to plot any data you are working with!

dataplot  =  ListPlot[data2]

We want to model this data with an exponential growth funtion. The function will be of the form:

model[t_, k_, A_]  =  A Exp[k t]

We need to choose A and k. We can choose A by simply forcing our model to pass through the initial point. Therefore, A=1650. To determine k, we must force our model to pass through another point. Let's choose that to be the second point, so

A  =  1650
k  =  1. /10  Log[1750/1650]

P[t_]  =  model[t, k, A]

Let's plot this model:

modelplot  =  Plot[P[t], {t, 0, 100}]

Show[modelplot, dataplot]

We see that the model passes through the first two data points, but does not model the data very well at all for later times. This is because the model has no knowledge of the data at the later times, and we should only expect it to be a reasonable model near the region where the points we fit it to are. We can see how unreasonable the model is by comparing its estimate for the world's population at 1996 to the data, which is 5770:

P[96]

We could force the model to go through a point other than the second point. This may make the model better in a different region. Let's choose the final point to determine k:

k  =  1. /96  Log[5770/1650]

P[t_]  =  model[t, k, A]

modelplot2  =  Plot[P[t], {t, 0, 100}]

Show[modelplot, modelplot2, dataplot]

Well! That looks better overall. But is it really? It is not a very good representation in the middle of our data set. What we really want is a balance of two things: we want to have the two points we use be close together, but far enough apart that we get a large range over which our model is valid. 

This model is pretty good near 1996. We could use it in this region with far more confidence than the first model we used. Compare the models predictions for 1990 and 1996 with the data (5300 and 5770 , respectively)

P[90]
P[96]

There is no reason we have to force the model to pass through a second point (or a first point, for that matter, but that is beyond our scope!).  Since we have a diffrent k value for each point (except the first, which we used to determine A), we could average over all of these and get a k that would represent the growth rate over the whole data set. Let's do that.

Clear[k]

We have the data as a list, and to access parts of the list we can use the Mathematica command Part. Notice how the following statement selects the second element of the list data2, and that this element is itself a list:

Part[data2, 2]

We can use it again to select the second element of the elements of the list data2.

Part[Part[data2, 2], 2]

In this way, we can access the nth y-coordinate of our data set through the command

datay[n_]  :=  Part[Part[data2, n], 2]

NOTE: we do not want to evaluate this yet, since we have not specified what n is. That is why we use the delayed assignment statement  := . Similarly, the nth t-coordinate of our data set is given by:

datat[n_]  :=  Part[Part[data2, n], 1]

Now why did we do all this? Oh yeah, so we could find an average value of k. We could, of course, find the average by hand.

k[n_]  :=  1. /datat[n] Log[datay[n]/A]
kave  =  Sum[k[n], {n, 2, 11}]/10

Our new, hopefully better model will be

P[t_]  =   model[t, kave, A]

modelplot3  =  Plot[P[t], {t, 0, 100}]

Show[modelplot3, modelplot2, modelplot, dataplot]

Well, our new model gives us what we should expect. It falls in between  the two previous fits, and is an effort to fit the entire data set. This gives a result which is not very good.

What have we learned?

We have seen that models should be set up to fit the area of the data set you are interested in. If you are extrapolating the data set, it may be wise to ignore the early data. If we are interested in modeling population for the year 2010, then we would get a better model if we concentrated on the years 1950 to 1996, ignoring the earlier years completely. The maxim is, you CAN have to much data to model properly!

Dropping earlier data

With the above idea in mind, lets create a new data set that measure years from 1950:

data3  =  {{0, 2520}, {10, 3020}, {20, 3700}, {30, 4450}, {40, 
          5300}, {46, 5770}}

data3plot  =  ListPlot[data3]

Modeling this we would get:

A = 2520
k  =  1. /10  Log[3020/A]

P[t_]  =  model[t, k, A]

modelplot3  =  Plot[P[t], {t, 0, 50}]

Show[modelplot3, data3plot]

We see that this is far better that any of previous attempts to fit near the end of the data set.