Chapter 1

Bobcats

In this section we create the bobcats analysis.

A model with three growth rates

We replicate our analysis for best, medium, and worst conditions, and show all three on a single graph.  One can see each part of the simple analysis replicated three times with different names.  To show all graphs on the same coordinate axes, give each one a name and then use the Show command.  Here we have made the graph of each model a different thickness so they can be identified on the combined graph.

Clear[popBest, popMedium, popWorst,n,Years];
Years=25;
rBest=0.01676;
rMedium=0.00549;
rWorst=-0.045;

popBest[0]=100;
popMedium[0]=100;
popWorst[0]=100;

popBest[n_]:=popBest[n]=(1+rBest) popBest[n-1];
popMedium[n_]:=popMedium[n]=(1+rMedium) popMedium[n-1];
popWorst[n_]:=popWorst[n]=(1+rWorst) popWorst[n-1];

bobcatsBest=Table[{n,popBest[n]},{n,0,Years}];
bobcatsMedium=Table[{n,popMedium[n]},{n,0,Years}];
bobcatsWorst=Table[{n,popWorst[n]},{n,0,Years}];

bobcatsBest//TableForm
bobcatsMedium//TableForm
bobcatsWorst//TableForm

pBest=ListPlot[bobcatsBest,PlotJoined->True,AxesLabel->{"Years", "Population"}, PlotStyle->Thickness[0.005]];
pMedium=ListPlot[bobcatsMedium,PlotJoined->True,AxesLabel->{"Years", "Population"},PlotStyle->Thickness[0.01]];
pWorst=ListPlot[bobcatsWorst,PlotJoined->True,AxesLabel->{"Years", "Population"},PlotStyle->Thickness[0.015]];

Show[pBest,pMedium,pWorst];

In all of these cases, the population is growing or dying exponentially.

Their hunting strategies for the best case:

In all cases their strategies will fail to converge to a non-zero fixed point, since in the first three we're dealing with a linear or affine model with a value of R>1 (so the fixed point for the affine model is not finite), and in the fourth R<1 (so the population goes extinct).

Clear[pop1, pop2, pop3, pop4, p1, p2, p3, p4, n];
yearsToRun=25;

pop1[0]=100;
pop2[0]=100;
pop3[0]=100;
pop4[0]=100;

pop1[n_]:=pop1[n]=(1+rBest) pop1[n-1]-1;
pop2[n_]:=pop2[n]=(1+rBest) pop2[n-1]-5;
pop3[n_]:=pop3[n]=(1+rBest-.01) pop3[n-1];
pop4[n_]:=pop4[n]=(1+rBest-.05) pop4[n-1];

bobcats1=Table[{n,pop1[n]},{n,0,yearsToRun}];
bobcats2=Table[{n,pop2[n]},{n,0,yearsToRun}];
bobcats3=Table[{n,pop3[n]},{n,0,yearsToRun}];
bobcats4=Table[{n,pop4[n]},{n,0,yearsToRun}];

bobcats1//TableForm
bobcats2//TableForm
bobcats3//TableForm
bobcats4//TableForm

p1=ListPlot[bobcats1,PlotJoined->True,AxesLabel->{"Years", "Population"},PlotStyle->Thickness[0.005]];
p2=ListPlot[bobcats2,PlotJoined->True,AxesLabel->{"Years", "Population"},PlotStyle->Thickness[0.008]];
p3=ListPlot[bobcats3,PlotJoined->True,AxesLabel->{"Years", "Population"},PlotStyle->Thickness[0.011]];
p4=ListPlot[bobcats4,PlotJoined->True,AxesLabel->{"Years", "Population"},PlotStyle->Thickness[0.014]];

Show[p1,p2,p3,p4];

My hunting strategy for the best case:

I'm using a logistic model to converge to 200:

Clear[pop1, p1, n];
yearsToRun=10;
R=(1+rBest);
K=200;

pop1[0]=100;

pop1[n_]:=pop1[n]= pop1[n-1]*(R(1-pop1[n-1]/K)+1);

bobcats1=Table[{n,pop1[n]},{n,0,yearsToRun}];

p1=ListPlot[bobcats1,PlotJoined->True,AxesLabel->{"Years", "Population"},PlotStyle->Thickness[0.005],PlotRange->{75,225}];

bobcats1 // TableForm

Their hunting strategies for the worst case:

In these cases, adding animals will lead to stable fixed points. Adding percentages of animals will result in fixed points as long as the percentage added is not enough to send R>1 (so the fixed point is unstable).

Clear[pop1, pop2, pop3, pop4, p1, p2, p3, p4, n];
yearsToRun=100;

pop1[0]=100;
pop2[0]=100;
pop3[0]=100;
pop4[0]=100;

pop1[n_]:=pop1[n]=(1+rWorst) pop1[n-1]+3;
pop2[n_]:=pop2[n]=(1+rWorst) pop2[n-1]+10;
pop3[n_]:=pop3[n]=(1+rWorst+.01) pop3[n-1];
pop4[n_]:=pop4[n]=(1+rWorst+.05) pop4[n-1];

bobcats1=Table[{n,pop1[n]},{n,0,yearsToRun}];
bobcats2=Table[{n,pop2[n]},{n,0,yearsToRun}];
bobcats3=Table[{n,pop3[n]},{n,0,yearsToRun}];
bobcats4=Table[{n,pop4[n]},{n,0,yearsToRun}];

p1=ListPlot[bobcats1,PlotJoined->True,AxesLabel->{"Years", "Population"},PlotStyle->Thickness[0.005]];
p2=ListPlot[bobcats2,PlotJoined->True,AxesLabel->{"Years", "Population"},PlotStyle->Thickness[0.008]];
p3=ListPlot[bobcats3,PlotJoined->True,AxesLabel->{"Years", "Population"},PlotStyle->Thickness[0.011]];
p4=ListPlot[bobcats4,PlotJoined->True,AxesLabel->{"Years", "Population"},PlotStyle->Thickness[0.014]];

Show[p1,p2,p3,p4];

\(\(yearsToRun = 100; 

    bobcats1 = Table[{n, pop1[n]}, {n, 0, yearsToRun}]; 

    bobcats2 = Table[{n, pop2[n]}, {n, 0, yearsToRun}]; 

    bobcats3 = Table[{n, pop3[n]}, {n, 0, yearsToRun}]; 

    bobcats4 = Table[{n, pop4[n]}, {n, 0, yearsToRun}]; 


    p1 = ListPlot[bobcats1, PlotJoined -> True, 
        AxesLabel -> {"Years", \ "Population"}, 
        PlotStyle -> Thickness[0.005]]; 

    p2 = ListPlot[bobcats2, PlotJoined -> True, 
        AxesLabel -> {"Years", \ "Population"}, 
        PlotStyle -> Thickness[0.008]]; 

    p3 = ListPlot[bobcats3, PlotJoined -> True, 
        AxesLabel -> {"Years", \ "Population"}, 
        PlotStyle -> Thickness[0.011]]; 

    p4 = ListPlot[bobcats4, PlotJoined -> True, 
        AxesLabel -> {"Years", \ "Population"}, 
        PlotStyle -> Thickness[0.014]]; 

Show[p1, p2, p3, p4]; 
\)\)

My hunting strategy for the worst case:

I'm using a logistic model to converge to 200:

Clear[pop1, pop2, p1, p2, n];
yearsToRun=10;
R=(1+rWorst);
pop1[0]=100;
pop2[0]=100;
K1=200;
K2=50;
pop1[n_]:=pop1[n]= pop1[n-1]*(R(1-pop1[n-1]/K1)+1);
pop2[n_]:=pop2[n]= pop2[n-1]*(R(1-pop2[n-1]/K2)+1);

bobcats1=Table[{n,pop1[n]},{n,0,yearsToRun}];
bobcats2=Table[{n,pop2[n]},{n,0,yearsToRun}];

p1=ListPlot[bobcats1,PlotJoined->True,AxesLabel->{"Years", "Population"},PlotStyle->Thickness[0.005],PlotRange->{75,225}];
p1=ListPlot[bobcats2,PlotJoined->True,AxesLabel->{"Years", "Population"},PlotStyle->Thickness[0.005],PlotRange->{0,100}];

bobcats1 // TableFormbobcats2 // TableForm