Generating the Figures in Primer 1 of Otto and Day

Clear["Global`*"]

Figure P1.1 - Functions for the logistic

D[(((E^(a n)) (1+r))/((((E^(a K)) r)/(1-(E^(a K))))+(E^(a n)) (1-(((E^(a K)) r)/(1-(E^(a K))))))),n]/.n->0//Simplify

D[(((E^(a n)) (1+r))/((((E^(a K)) r)/(1-(E^(a K))))+(E^(a n)) (1-(((E^(a K)) r)/(1-(E^(a K))))))),n]/.n->K//Simplify

Show[
Plot[(1+r)-r n/K/.r->0.5/.K->100,{n,0,300}],
Plot[-r n^2/K^2+(1+r)/.r->0.5/.K->100,{n,0,300},PlotStyle->Dashing[{0.04}]],
Plot[(1+r) (Exp[-Log[(1+r)] n /K])/.r->0.5/.K->100,{n,0,300},PlotStyle->Dashing[{0.01}]],
Plot[(((E^(a n)) (1+r))/((((E^(a K)) r)/(1-(E^(a K))))+(E^(a n)) (1-(((E^(a K)) r)/(1-(E^(a K)))))))/.a->-0.05/.K->100/.r->0.5,{n,0,300},PlotStyle->Thickness[0.01]],
PlotRange->{{0,250},{-0.3,1.55}}
]

Export["FigP1-1a.eps",%];

Figure P1.3 - Quadratic functions

Show[
Plot[a x^2+b x +c/.{c->5,b->-8,a->2},{x,-1,5}],
Plot[a x^2+b x +c/.{c->-5,b->+8,a->-2},{x,-1,5},PlotStyle->Dashing[{0.01}]],
Ticks->None
]

Export["FigP1-3.eps",%];

Figure P1.4 - Exponential functions

Show[
Plot[c Exp[a x]/.{c->1,a->1/20},{x,0,30}],
Plot[c Exp[a x]/.{c->1,a->-1/10},{x,0,30},PlotStyle->Dashing[{0.01}]],PlotRange->{{0,30},{0,5}},
Ticks->None, AxesOrigin->{0,0}
]

Export["FigP1-4.eps",%];

Figure P1.5 - Hyperbolic functions

D[(a x+c)/(b x+d ),x]/.x->0//Factor

Show[
Plot[(a x+c)/(b x+d )/.{c->1,b->4,a->8,d->1},{x,0,5},PlotRange->{{0,4},{0,2}}],
Plot[(a x+c)/(b x+d )/.{c->1,b->4,a->1,d->1},{x,0,5},PlotRange->{{0,4},{0,2}},PlotStyle->Dashing[{0.01}]],
Ticks->None,AxesOrigin->{0,0}
]

Export["FigP1-5.eps",%];

Figure P1.6 - Bell-shaped functions

Show[
Plot[h Exp[-(x-b)^2/a]/.{h->1,b->2,a->1/3},{x,0,5}],
Plot[h Exp[-(x-b)^2/a]/.{h->1,b->2,a->1},{x,0,5},PlotStyle->Dashing[{0.01}]],
Ticks->None,PlotRange->{{0,4},{0,1.5}},AxesOrigin->{0,0}
]

Export["FigP1-6.eps",%];

Figure P1.7 - S-shaped functions

Show[
Plot[(c  Exp[a x])/((1-c) +c  Exp[a x])/.{c->0.01,a->1/10},{x,0,100}],
Plot[(c  Exp[a x])/((1-c) +c  Exp[a x])/.{c->0.99,a->-1/10},{x,0,100},PlotStyle->Dashing[{0.01}]],
PlotRange->All]

Export["FigP1-7.eps",%];

Figure P1.8 - Logistic Growth (Discrete Time)

Clear[num,num2,num3,num4, r,K]
num[K_,r_,t_]:=num[K,r,t]=
		num[K,r,t-1]((1+r)-r num[K,r,t-1]/K)
num[K_,r_,0]:= 5.0

num2[K_,r_,t_]:=num2[K,r,t]=
		If[test=num2[K,r,t-1](-r num2[K,r,t-1]^2/K^2+(1+r));test>0, test,0]
num2[K_,r_,0]:= 5.0

num3[K_,r_,t_]:=num3[K,r,t]=
		num3[K,r,t-1]((1+r) (Exp[-Log[(1+r)] num3[K,r,t-1]/K]))
num3[K_,r_,0]:=5.0

num4[K_,r_,a_,t_]:=num4[K,r,a,t]=
		num4[K,r,a,t-1]((((E^(a num4[K,r,a,t-1])) (1+r))/((((E^(a K)) r)/(1-(E^(a K))))+(E^(a num4[K,r,a,t-1])) (1-(((E^(a K)) r)/(1-(E^(a K))))))))
num4[K_,r_,a_,0]:= 5.0

Show[ListPlot[Table[{t,num[100,0.5,t]},{t,0,50}],Joined->True,PlotRange->All],ListPlot[Table[{t,num2[100,0.5,t]},{t,0,50}],Joined->True,PlotStyle->Dashing[{0.04}],PlotRange->All],ListPlot[Table[{t,num3[100,0.5,t]},{t,0,50}],Joined->True,PlotStyle->Dashing[{0.01}],PlotRange->All],ListPlot[Table[{t,num4[100,0.5,-0.015,t]},{t,0,50}],Joined->True,PlotStyle->Thickness[0.01],PlotRange->All],ListPlot[Table[{t,num4[100,0.5,-0.05,t]},{t,0,50}],Joined->True,PlotStyle->Thickness[0.01],PlotRange->All],
PlotRange->{{0,15},{0,110}},AxesOrigin->{0,0}]

Export["FigP1-8a.eps",%];

For higher values of r:

Show[ListPlot[Table[{t,num[100,2,t]},{t,0,50}],Joined->True,PlotRange->All],ListPlot[Table[{t,num2[100,2,t]},{t,0,50}],Joined->True,PlotStyle->Dashing[{0.04}],PlotRange->All],ListPlot[Table[{t,num3[100,2,t]},{t,0,50}],Joined->True,PlotStyle->Dashing[{0.01}],PlotRange->All],ListPlot[Table[{t,num4[100,2,-0.015`,t]},{t,0,50}],Joined->True,PlotStyle->Thickness[0.01],PlotRange->All],ListPlot[Table[{t,num4[100,2,-0.05`,t]},{t,0,50}],Joined->True,PlotStyle->Thickness[0.01],PlotRange->All],
PlotRange->{{0,15},{0,150}},AxesOrigin->{0,0}]

Export["FigP1-8b.eps",%];

Interestingly, the S-shaped function relating offspring number to current population size is sensitive to both changes in r and a, leading to chaos when either becomes large, as can be shown by increasing either in the following graph:

Manipulate[ListPlot[Table[{t,num4[100,r,a,t]},{t,0,100}],Joined->True],{{r,0.1},0.01,2},{{a,-0.1},-0.001,-1}]

Figure P1.9 - Taylor series of exp[x]

Series[Exp[x],{x,0,10}]

Normal[Series[Exp[x],{x,0,1}]]

{Exp[x],Normal[Series[Exp[x],{x,0,1}]],Normal[Series[Exp[x],{x,0,2}]],Normal[Series[Exp[x],{x,0,3}]],Normal[Series[Exp[x],{x,0,6}]]}

Plot[{(E^x),1+x,1+x+((x^2)/2),1+x+((x^2)/2)+((x^3)/6),1+x+((x^2)/2)+((x^3)/6)+((x^4)/24)},{x,0,3},PlotStyle->{Thickness[0.01],Dashing[{.001,0.01}],Dashing[{.005,0.03}],Dashing[{.02}],Dashing[{.04}]}]

Export["FigP1-9.EPS",%]

Figure P1.10 - Taylor series of ln[x]

Series[Log[x],{x,1,6}]

Plot[{Log[x],(x-1),(x-1)-(1/2) (((x-1))^2),(x-1)-(1/2) (((x-1))^2)+(1/3) (((x-1))^3),(x-1)-(1/2) (((x-1))^2)+(1/3) (((x-1))^3)-(1/4) (((x-1))^4)},{x,0,3},PlotRange->{-1.75,1.75},PlotStyle->{Thickness[0.01],Dashing[{.001,0.01}],Dashing[{.005,0.03}],Dashing[{.02}],Dashing[{.04}]}]

Export["figP1-10.EPS",%]

Figure P1.11 - Approximating the sine function

This rewrites the sine function as a Taylor Series up to k:

taylorsine[k_,a_]=Sum[(D[Sin[x],{x,i}]/.x->a)/(i!)(x-a)^i,{i,0,k}]

Show[
Plot[Sin[x],{x,0,4 Pi},PlotStyle->Thickness[0.01]],
Plot[taylorsine[0,1],{x,0,4 Pi},PlotStyle->Dashing[{0.005,0.04}]],
Plot[taylorsine[1,1],{x,0,4 Pi},PlotStyle->Dashing[{0.02,0.02}]],
Plot[taylorsine[2,1],{x,0,4 Pi},PlotStyle->Dashing[{0.04,0.04}]],
Plot[taylorsine[10,1],{x,0,4 Pi}],
PlotRange->{{0,2 Pi},{-1.5,1.5}}
]

D[Exp[x]/(1+Exp[x]),x]/.x->0

Exp[x]/(1+Exp[x])/.x->0.1

1/(1+x)/.x->0.1