Fitting P(t) to the 1950-1990 Data: The Results

Following the plan of the previous section, we begin with a table of growth rates.

> dataCensus:=readdata(USAPopCensus17901990,[integer,float]):
ndc:=nops(dataCensus):

GrRate:=[seq([dataCensus[i][1],(dataCensus[i+1][2]-dataCensus[i-1][2])/(20)],i=2..ndc-1)]:

headers:=["year","growth rate"]:
printtable(GrRate,"Growth Rate (two-sided) Estimates",headers);

plot(GrRate, style=point);

                           Growth Rate (two-sided) Estimates

                             year               growth rate

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

                             1800                164.750000

                             1810                216.050000

                             1820                283.850000

                             1830                375.100000

                             1840                518.000000

                             1850                719.650000

                             1860                832.200000

                             1870                937.450000

                             1880               1157.550000

                             1890               1291.600000

                             1900               1467.550000

                             1910               1518.350000

                             1920               1533.500000

                             1930               1283.050000

                             1940               1430.350000

                             1950               2427.450000

                             1960               2659.750000

                             1970               2352.550000

                             1980               2252.250000

Where does the maximum growth rate occur?

We now follow the plan of the previous section for the period 1950-1990.

> data3:=[seq(dataCensus[i],i=17..21)];

Solve the equations:

> with(math3):
clear(c,L,K);
eqns:={151684.=L/(1+exp(-K*(1950-c))),2659.750000=K*L/4,180671.=L/2};
vars:={L,K,c};
solns:=solve(eqns,vars);

> L1:=convert(solns,list);

Warning: the numbers L1[*] may have to be changed depending on the order of the solutions in the list above.

> K:=rhs(L1[1]);
c:=rhs(L1[2]);
L:=rhs(L1[3]);

> f:=x->L/(1+exp(-K*(x-c)));
plot(f(x),x=1950..2010);

Do you see the inflection point? Where is it and how do you know?

> p1:=plot(f(x),x=1950..2010):
p2:=plot(data3,style=point):
with(plots):
display([p1,p2]);

> plot(f(x),x=1950..2100);

What is the limiting size of the population?

Error analysis:

> ferror:=[seq([data3[i][1],abs(f(1950+10*(i-1))-data3[i][2]),abs(f(1950+10*(i-1))-data3[i][2])/data3[i][2]*100],i=1..5)]:
toterrorf:=add((f(1950+10*(i-1))-data3[i][2])^2,i=1..5):

with(math3):
headers:=["year","absolute error","% error"]:
printtable(ferror,"Logistic Fit", headers);
TotalSqrError:=toterrorf;

                                      Logistic Fit

                 year            absolute error               % error

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

                 1950                 .000400                   .000000

                 1960             2641.946200                  1.462297

                 1970              392.035900                   .191350

                 1980             2222.625400                   .976026

                 1990             3526.511900                  1.411034

How does the error here compare with the error from the previous fit with a logistic curve? What accounts for the difference?