Homework 2

Problem 1a-c

yA[t_,alpha_,beta_,delta_]=alpha/(1+beta Exp[-delta t])

t=Table[i,{i,1790,1990,10}];
y={3929214,5308483,7239881,9638453,12866020,17069453,23191876,31433321,39818449,50155783,62947714,75994575,91972266,105710620,122775046,131669275,151325798,179323175,203302031,226545805,248709873}/10.^6;
TableForm[ArrayReshape[Transpose[{t,y}],{2,10,2}]]

dataPlot=ListPlot[Transpose[{t,y}],PlotMarkers->Automatic,PlotRange->All,GridLines->Automatic,Frame->True,FrameLabel->{"Year","Population (millions)"},PlotStyle->Black]

t0=t[[1]];y0=y[[1]];
data=Transpose[{(t-t0)/10,Log[y]}];
lsqsol=Fit[data,{1,x},x]

{A,r}={Exp[Coefficient[lsqsol,x,0]],Coefficient[lsqsol,x,1]}
fitPlot=Plot[A Exp[r (year-t0)/10],{year,t[[1]],t[[-1]]},PlotStyle->Red,ImageSize->Large,PlotRange->All]

aPlot=Plot[yA[year-1790,387.9802,54.0812,0.0270347],{year,t[[1]],t[[-1]]},PlotStyle->Green,PlotRange->All,PlotRange->All]

Show[{dataPlot,fitPlot,aPlot},PlotRange->All]

yB = NonlinearModelFit[Transpose[{t-1790,y}],yA[τ,α,β,γ],{{α,388.},{β,54.},{γ,0.027}},τ]

Normal[yB]

bPlot=Plot[yB[year-1790],{year,t[[1]],t[[-1]]},PlotStyle->Magenta,PlotRange->All,PlotRange->All]

Show[{dataPlot,fitPlot,aPlot,bPlot},PlotRange->All]