Math 3280 - Hampton - Lab 5 - Due 7/3

Curve fitting and linear algebra.

Here's the census data for the population of the US (in millions):

poplist={{1790,3.939},{1800,5.308},{1810,7.24},{1820,9.638},{1830,12.866},{1840,17.069},{1850,23.192},{1860,31.443},{1870,38.558},{1880,50.156},{1890,62.948},{1900,75.995},{1910,91.972},{1920,105.711},{1930,122.775},{1940,131.669},{1950,150.697},{1960,179.323},{1970,203.185},{1980,226.542},{1990,248.709},{2000,281.421}};
dataplot=ListPlot[poplist,PlotJoined->True,PlotRange->All,PlotStyle->{Red}]

Here is an example of using mathematica to fit a quadratic curve to the data.  First we define a general quadratic function q[x]:

q[x_]:=A x^2 + B x + C

Next we can make a list of all the conditions that the graph of q[x] would have to satisfy to go through all our data points.

AskingTooMuch=Map[q[#[[1]]]==#[[2]]&,poplist];

Of course, it is unlikely that a quadratic curve exists that would go through all these points.  We can pick three - lets take the first three and see how good the fit is.

JustEnough=AskingTooMuch[[{1,2,3}]]

We can see this system in matrix form if we read off the coefficients and display it using MatrixForm:

CoeffMatrix=Map[{Coefficient[#,A],Coefficient[#,B],Coefficient[#,C]}&,JustEnough[[All,1]]]

MatrixForm[CoeffMatrix]

We can solve the system in many ways, such as row-reducing the augmented matrix.  Lets solve this using an inverse:

ExampleInverse=Inverse[CoeffMatrix]

Matrix multiplication is done with a "." in mathematica

ExampleInverse.JustEnough[[All,2]]

FittedQuadratic[x_]:=q[x]/.{A->0.002815,B->-9.96895`,C->8828.82};

plot1=Plot[FittedQuadratic[x],{x,1790,2000}]

plot2=ListPlot[poplist]

Show[plot1,plot2]

Exercises

1.  Use the following Manipulate cell to try to model the US population using the exponential growth model.  Explain whether or not it seems to be a good model.  Record the best values of p0 and k that you find.

Manipulate[Show[{dataplot,Plot[p0 Exp[k (t-1790)],{t,1790,2000}]}],{p0,4,100},{k,.001,.03}]

2. Repeat the previous exercise, but using the logistic population model.  Does this fit the data better?  As before, record the best values for the parameters.

Manipulate[Show[{dataplot,Plot[(((E^(k (t-1790))) M p0)/(M+(-1+(E^(k (t-1790)))) p0)),{t,1790,2000}]}],{p0,4,100},{k,.001,.05},{M,50,500}]

3. Try to find a quadratic curve that fits the data as well as possible, as described above.

4.  Using the method above or some other way (Cramer's Rule, row reduction, etc), fit a cubic curve to some of the population data points and discuss the results.  Try to find the best-fitting cubic.  How does this compare to the other fits?

cubic[x_]:=A x^3 + B x^2 + C x+D