MATH564 Homework 2: Population model

Topics

Discrete growth & decay model

popD[n_,ρ_]=y[n]/.RSolve[{y[n+1] - y[n]==ρ y[n],y[0]==1},y[n],n][[1,1]]

Manipulate[ListPlot[Table[{n,popD[n,ρ]},{n,1,10}]],{ρ,0,1}]

Exponential growth & decay model

Constant growth rate (Malthus, 1798)

pop[t_,r_]=y[t]/.DSolve[{y'[t]==r y[t],y[0]==1},y,{t,0,10}][[1,1]];

Manipulate[Plot[pop[t,r],{t,0,10}],{r,-1,1}]

Maturation

Delay differential equation solution using Mathematica functions

pop[t_,r_]=y[t]/.DSolve[{y'[t]==r y[t-1],y[t/;t≤0]==1},y,{t,0,10}][[1,1]]

Evaluate[pop[4.,0.1]]

Manipulate[Plot[pop[t,r],{t,0,10}],{r,-1,1}]

DSolve[{y'[t]==r 1,y[0]==1},y[t],t][[1,1]]

DSolve[{y'[t]==r (1+r t),y[1]==1+r},y[t],t][[1,1]]

Fitting growth model to data

data = Table[{t,1+t},{t,0,3,0.25}]

model[x_]=Fit[data,{1,x},x]

modelpredictdata= Table[N[{t,model[t]}],{t,0,3,Sqrt[2]/10}]

?FindFit

expmodel[t_] = a Exp[b t] /. FindFit[modelpredictdata,a Exp[b t],{a,b},t]

mpdplt = ListPlot[modelpredictdata];
expplt = Plot[expmodel[t],{t,0,3}];
Show[mpdplt,expplt]

expmodelpredict= Table[N[{t,expmodel[t]}],{t,0,3,Sqrt[2]/10}]

{{0.`,1.3107225207105826`},{0.1414213562373095`,1.3853765670938663`},{0.28284271247461906`,1.464282639785797`},{0.42426406871192857`,1.547682918930725`},{0.5656854249492381`,1.6358333783840593`},{0.7071067811865477`,1.7290045713525004`},{0.848528137423857`,1.8274824607815174`},{0.9899494936611666`,1.9315692970387128`},{1.1313708498984762`,2.0415845455868804`},{1.2727922061357857`,2.1578658674939843`},{1.4142135623730951`,2.280770155789471`},{1.5556349186104046`,2.410674630847707`},{1.697056274847714`,2.547977998160527`},{1.8384776310850235`,2.693101672052344`},{1.9798989873223332`,2.8464910690936787`},{2.121320343559643`,3.008616975182878`},{2.2627416997969525`,3.179976990491894`},{2.404163056034262`,3.361097056710988`},{2.5455844122715714`,3.552533071279798`},{2.687005768508881`,3.7548725935592304`},{2.8284271247461903`,3.9687366481807405`},{2.9698484809835`,4.1947816311079436`}}

Norm[Transpose[modelpredictdata][[2]]-Transpose[expmodelpredict][[2]]]/Norm[Transpose[modelpredictdata][[2]]]

Limits on population growth

Logistic model

Off[Solve::ifun];
y[t_,r_,K_,z0_]=z[t]/. DSolve[{z'[t]==r z[t] (1-z[t]/K),z[0]==z0},z[t],t][[1,1]];
logisticPlots=Plot[Table[y[t,r,K,0.5],{r,0.25,1,0.25},{K,0.5,1.5,0.5}],{t,0,10},Frame->True,FrameLabel->{"time","population"},PlotLabel->"Logistic population model",GridLines->Automatic];
SetDirectory[$HomeDirectory<>"/courses/MATH564/lessons/images"];
Export["logisticPlots.png",logisticPlots];
Show[logisticPlots]

Discrete logistic model

yd[rho_,K_,t1_]:=RecurrenceTable[{z[t+1]-z[t]==rho z[t] (1-z[t]/K),z[0]==1},z[t],{t,0,t1}];

logisticdifPlots=GraphicsGrid[Table[ListPlot[yd[r,k,100],Frame->True,Joined->True,GridLines->Automatic],{k,2.,3.,1.},{r,1.,3.,1.}]];
Export[$HomeDirectory<>"/courses/MATH564/lessons/images/logisticdifPlots.png",logisticdifPlots];
Show[logisticdifPlots]

Problems

Problems 1-4, one point each. Exercises are from the textbook, Mathematical Biology : An Introduction with Maple and Matlab by Ronald Shonkwiler and James Herod.

Problem 1: Population model parameters from data

Exercise 1, p. 104

Exercise 2, p. 104

Problem 2: Assessing quality of fitted models

Exercise 3, p. 104

Exercise 4, p. 104

Problem 3: Logistic model with fitted parameters

Exercise 1, p. 125

Problem 4: Logistic model with specified parameters

Exercise 3, p. 126