Fitting a Line to the 1860-1940 Data

> second:=[seq(dataPvsRel[i],i=7..15)]:
newsecond:=[seq([second[i][1],second[i][2]/100],i=1..9)]:

> xdata:=map(x->x[1],newsecond);
ydata:=map(x->x[2],newsecond);

> with(stats):
with(math3):
clear(a,b):
linefit:=fit[leastsquare[[x,y],y=a*x+b]]([xdata,ydata]);

lineplot:=plot(rhs(linefit),x=31500..133000,y=0.005..0.03):
secondplot:=plot(newsecond,style=point):
with(plots):
display([secondplot,lineplot]);

We now have modeled with a line the relative growth rate data, as a function of , between 1860 and 1940. Thus, we have the relationship , a differential equation that we must solve for . We have already solved this equation in Chapter 3. This will be clear if we rewrite it in the form . You should do that. You should also show that and . Then you will be able to determine the exact solution from your work in Chapter 3 which we will state here, namely, where .

> data2:=[seq(dataCensus[i],i=8..16)];

> a:=coeff(rhs(linefit),x,1);
b:=coeff(rhs(linefit),x,0);
K:=b;
L:=-b/a;
P0:=data2[1][2];
A:=(L-P0)/P0;

f2:=t->L/(1+A*exp(-K*(t-1860)));

Thus, the exponential fitting function and its graph with the original census data between 1860 and 1940 are:

> with(plots):
p1:=plot(data2, style=point):
p2:=plot(f2(t),t=1860..1940):
display([p1,p2]);

The total error with this fit is:

> f2error:=[seq([data2[i][1],abs(f2(1860+10*(i-1))-data2[i][2]),abs(f2(1860+10*(i-1))-data2[i][2])/data2[i][2]*100],i=1..9)]:
toterrorf2:=add((f2(1860+10*(i-1))-data2[i][2])^2,i=1..9):

with(math3):
headers:=["year","absolute error","% error"]:
printtable(f2error,"Rel Growth Rate Fit", headers);
TotalSqrError:=toterrorf2;

                                   Rel Growth Rate Fit

                 year             absolute error               % error

                 -------------------------------------------------------

                 1860                 0.000000                  0.000000

                 1870               583.917980                  1.463270

                 1880               970.739890                  1.931359

                 1890               615.952500                   .976834

                 1900              1437.365400                  1.888934

                 1910                79.436600                   .085964

                 1920               959.832200                   .901581

                 1930               958.228400                   .778560

                 1940              3676.763700                  2.782855

Here is a plot of this logistic curve over a longer time interval. Note the value of and the classic shape of the logistic curve.

> plot(f2(t),t=1860..2010);

This is the curve that we would have used in 1940 to predict the future size of the population. Note that the predicted limit is 200 million! We would have predicted the population in 1980 to be 174,284 people:

> f2(1980);

The actual value from census data turned out to be 227,722 . What do you think happened to account for this difference? Does the curve even predict the population in 1950 correctly? Explain.