(*^ ::[ Information = "This is a Mathematica Notebook file. It contains ASCII text, and can be transferred by email, ftp, or other text-file transfer utility. It should be read or edited using a copy of Mathematica or MathReader. If you received this as email, use your mail application or copy/paste to save everything from the line containing (*^ down to the line containing ^*) into a plain text file. On some systems you may have to give the file a name ending with ".ma" to allow Mathematica to recognize it as a Notebook. The line below identifies what version of Mathematica created this file, but it can be opened using any other version as well."; FrontEndVersion = "Macintosh Mathematica Notebook Front End Version 2.2"; MacintoshStandardFontEncoding; fontset = title, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e8, 24, "Times"; fontset = subtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e6, 18, "Times"; fontset = subsubtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, italic, e6, 14, "Times"; fontset = section, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, grayBox, M22, bold, a20, 18, "Times"; fontset = subsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, blackBox, M19, bold, a15, 14, "Times"; fontset = subsubsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, whiteBox, M18, bold, a12, 12, "Times"; fontset = text, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; fontset = smalltext, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Times"; fontset = input, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeInput, M42, N23, bold, L-5, 12, "Courier"; fontset = output, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L-5, 12, "Courier"; fontset = message, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, R65535, L-5, 12, "Courier"; fontset = print, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L-5, 12, "Courier"; fontset = info, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, B65535, L-5, 12, "Courier"; fontset = postscript, PostScript, formatAsPostScript, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeGraphics, M7, l34, w282, h287, 12, "Courier"; fontset = name, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, italic, 10, "Geneva"; fontset = header, inactive, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; fontset = leftheader, inactive, L2, 12, "Times"; fontset = footer, inactive, noKeepOnOnePage, preserveAspect, center, M7, 12, "Times"; fontset = leftfooter, inactive, L2, 12, "Times"; fontset = help, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Times"; fontset = clipboard, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; fontset = completions, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; fontset = special1, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; fontset = special2, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; fontset = special3, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; fontset = special4, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; fontset = special5, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; paletteColors = 128; automaticGrouping; currentKernel; ] :[font = section; inactive; preserveAspect; startGroup] CHAPTER 2 :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 1 :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] 1a :[font = text; inactive; preserveAspect] D[f,x] differentiates f with respect to x: ;[s] 6:0,1;6,0;22,1;23,0;40,1;41,0;43,-1; 2:3,13,9,Times,0,12,0,0,0;3,13,9,Times,1,12,0,0,0; :[font = input; preserveAspect] n[t_]:=a Exp[r t] :[font = input; preserveAspect] D[n[t],t] :[font = text; inactive; preserveAspect] Verify that this derivative is equal to rn[t] and that n[t] has the correct initial value: ;[s] 5:0,0;40,1;45,0;55,1;59,0;91,-1; 2:3,13,9,Times,0,12,0,0,0;2,13,9,Times,1,12,0,0,0; :[font = input; preserveAspect] r n[t] :[font = input; preserveAspect; endGroup] n[0] :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] 1b :[font = text; inactive; preserveAspect] DSolve[] solves a differential equation; you must first clear the existing definition of n: ;[s] 4:0,0;8,1;89,0;90,1;92,-1; 2:2,13,9,Times,1,12,0,0,0;2,13,9,Times,0,12,0,0,0; :[font = input; preserveAspect] Clear[n] :[font = input; preserveAspect; endGroup; endGroup] DSolve[{n'[t]==r n[t],n[0]==a},n[t],t] :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 2 :[font = text; inactive; preserveAspect] I first calculate and plot the logarithms of the numbers. :[font = input; preserveAspect] logdata=N[Log[{8,30,81,282,705,1325}]]; :[font = input; preserveAspect] logplot=ListPlot[logdata,PlotRange->{{0,6},{1.5,7.5}}, AxesOrigin->{0,1.5}] :[font = text; inactive; preserveAspect] I now calculate and plot the best-fitting line: :[font = input; preserveAspect] regline=Fit[logdata,{1,t},t] :[font = input; preserveAspect] Show[logplot,Plot[regline,{t,1,6}, DisplayFunction->Identity]] :[font = text; inactive; preserveAspect; endGroup] Notes: Log[list] will return a list of the logarithms of the elements of list, but in this case N is needed to convert integers to real numbers. Note the use of Plot and ListPlot for plotting continuous curves and lists of data respectively, and of Show for combining two or more graphics in a single plot. Fit calculates regressions by least squares. In this case {1,t} fits a linear regression, with an intercept (called for by 1) and a slope (called for by t). ;[s] 23:0,0;7,1;11,2;15,1;16,0;73,2;77,0;96,1;97,0;161,1;165,0;170,1;178,0;249,1;253,0;307,1;310,0;365,1;370,0;430,1;431,0;460,1;461,0;464,-1; 3:11,13,9,Times,0,12,0,0,0;10,13,9,Times,1,12,0,0,0;2,14,10,Times,2,12,0,0,0; :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 3 :[font = text; inactive; preserveAspect] Solve the logistic equation as in Exercise 1b (giving the name logisticsoln to the rule for the solution and calling the initial value a and the parameters r and k) by writing logisticsoln=DSolve[..]. ;[s] 5:0,0;63,1;75,0;176,1;199,0;202,-1; 2:3,13,9,Times,0,12,0,0,0;2,13,9,Times,1,12,0,0,0; :[font = text; inactive; preserveAspect] Note that logisticsoln is a replacement rule n[t]Ð>xxx; if we write n[t]/.logisticsoln, where /. (pronounced "slash dot" and meaning "evaluated at") is the replacement operator, then n[t] is temporarily replaced by xxx ;[s] 12:0,0;10,1;23,0;45,1;54,0;68,1;86,0;94,1;97,0;183,1;187,0;215,1;219,-1; 2:6,13,9,Times,0,12,0,0,0;6,13,9,Times,1,12,0,0,0; :[font = input; preserveAspect] n[t]/.logisticsoln :[font = text; inactive; preserveAspect] The solution with values of r, k and a temporarily assigned the values 0.1, 1000 and 1500 can be plotted thus :[font = input; preserveAspect; endGroup] Plot[n[t]/.logisticsoln/.{r->0.1,k->1000,a->1500}, {t,0,30},PlotRange->All] :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 4 :[font = text; inactive; preserveAspect] Choose parameter values giving the same carrying capacity and initial rate of increase for the two models and plot the curves. You can superimpose the two curves making one solid and the other dotted as in the following example: :[font = input; preserveAspect; endGroup] Plot[{Sin[x],Cos[x]},{x,0,4Pi}, PlotStyle->{{Thickness[0.004]},{Dashing[{.05,.05}]}}] :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 5 :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] 5a :[font = input; preserveAspect] gausedata={2,10,10,11,21,56,104,137,165,194,217, 199,201,182,192,179,190,206,209,196, 195,234,210,210,180}; :[font = text; inactive; preserveAspect] The days are not in exact sequence so that to plot the data against time it is necessary to compute a matrix {{0,2},{2,10},{3,10},...,{25,180}}: :[font = input; preserveAspect; endGroup] pairsdata=Transpose[{Range[25],gausedata}]; pairsdata[[1,1]]=0; gauseplot=ListPlot[pairsdata] :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] 5b :[font = text; inactive; preserveAspect] We first show that (KÐn)/n is proportional to exp(Ðrt). (I assume that logisticsoln is defined from Ex 3 as the replacement rule for the logistic curve. If not, you must define it by entering logisticsoln=n[t]Ð>xxx): ;[s] 5:0,0;71,1;83,0;192,1;214,0;217,-1; 2:3,13,9,Times,0,12,0,0,0;2,13,9,Times,1,12,0,0,0; :[font = input; preserveAspect] (k-n[t])/n[t]/.logisticsoln :[font = input; preserveAspect] Simplify[%] :[font = text; inactive; preserveAspect] We now estimate K and r: :[font = input; preserveAspect] k=Sum[gausedata[[i]],{i,10,25}]/16 //N :[font = input; preserveAspect] data9=Take[gausedata,9] pairs9=Transpose[{Range[9],Log[(kÐdata9)/data9]}]//N :[font = input; preserveAspect] pairs9[[1,1]]=0; :[font = input; preserveAspect] Fit[pairs9,{1,t},t] :[font = text; inactive; preserveAspect; endGroup; endGroup] Assign r the value from the negative slope of this line, then plot the logistic curve and superimpose it on the data. (Since r and k have been assigned values, they should not be included in the temporary replacement rule in plotting the logistic curve.) :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 6 :[font = text; inactive; preserveAspect; endGroup] Adapt Exercise 5 :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 7 :[font = text; inactive; preserveAspect] Clear the existing values of r and k, define and differentiate the function, simplify it since it looks rather complicated, and then evaluate it at the equilibrium values. % denotes the output from the previous calculation; this notation should be used sparingly. ;[s] 7:0,0;29,1;30,0;35,1;36,0;172,1;173,0;264,-1; 2:4,13,9,Times,0,12,0,0,0;3,13,9,Times,1,12,0,0,0; :[font = input; preserveAspect] Clear[r,k] f[n_]:=r (1-n/k) n :[font = input; preserveAspect] D[f[n],n] :[font = input; preserveAspect] Simplify[%] :[font = input; preserveAspect; endGroup] %/.{{n->0},{n->k}} :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 8 :[font = text; inactive; preserveAspect; endGroup] Adapt Exercise 7. :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 9 :[font = input; preserveAspect] F[n_]:=n Exp[r (1-n/k)] :[font = text; inactive; preserveAspect; endGroup] Evaluate this function at 0 and k, and then evaluate its derivatives at these points. :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 10 :[font = text; inactive; preserveAspect] The operator NestList[] provides a powerful method of iteration. For example ;[s] 3:0,0;13,1;23,0;77,-1; 2:2,13,9,Times,0,12,0,0,0;1,13,9,Times,1,12,0,0,0; :[font = input; preserveAspect] r=2.5; k=1000; NestList[F,800,10] :[font = text; inactive; preserveAspect] returns a list of the values obtained by iterating F(n) 10 times, starting with the initial value 800. (Thus there are 11 values altogether.) The parameters in the function must be assigned values before NestList[] is used. This list of values can be passed for plotting to ListPlot: ;[s] 5:0,0;205,1;215,0;275,1;283,0;285,-1; 2:3,13,9,Times,0,12,0,0,0;2,13,9,Times,1,12,0,0,0; :[font = input; preserveAspect] ListPlot[NestList[F,800,10],PlotJoined->True] :[font = text; inactive; preserveAspect] The graphics option PlotJoinedÐ>True joins the points by lines. Some experimentation with further graphics options such as AxesOrigin and PlotRange may be needed to make the graph look pretty. ;[s] 7:0,0;20,1;36,0;123,1;133,0;138,1;147,0;193,-1; 2:4,13,9,Times,0,12,0,0,0;3,13,9,Times,1,12,0,0,0; :[font = text; inactive; preserveAspect; endGroup] Use this method to investigate the behavior of the iterates of F(n) with different values of r and k and with different initial values. :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 11 :[font = text; inactive; preserveAspect] First enter the data, data={. , ... , .}. Then calculate ;[s] 3:0,0;22,1;40,0;57,-1; 2:2,13,9,Times,0,12,0,0,0;1,13,9,Times,1,12,0,0,0; :[font = input; preserveAspect] logdata=N[Log[data]]; var1=Rest[logdata]; var2=Drop[logdata,-1]; pairsdata=Transpose[{var2,var1}]; :[font = text; inactive; preserveAspect] var1 is the list of log numbers with its first element dropped, var2 is the list with its last element dropped, and pairsdata is the list of pairs of values {{x1,x2},{x2,x3},...,{xnÐ1,xn}}, where xt = log nt. Thus ListPlot[pairsdata] will give the required plot, and Fit[pairsdata,{1,x},x] will give the ordinary least squares fit. ;[s] 26:0,0;4,1;64,0;68,1;116,0;126,1;160,2;161,1;163,2;164,1;168,2;169,1;171,2;172,1;180,2;183,1;185,2;186,1;197,2;199,1;206,2;207,1;214,0;233,1;267,0;289,1;332,-1; 3:5,13,9,Times,1,12,0,0,0;13,13,9,Times,0,12,0,0,0;8,21,13,Times,64,12,0,0,0; :[font = text; inactive; preserveAspect] The package MonteCarlo contains a procedure called Pollard which will implement the test of Pollard et al. (1987) for density dependence. You must first read in the package by using the command <