(*^ ::[ 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 3 :[font = subsection; inactive; preserveAspect; startGroup] 1 :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] 1a :[font = text; inactive; preserveAspect; endGroup] Use pencil and paper. :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] 1b :[font = text; inactive; preserveAspect] The procedure sol[a,b,t] calculates the numerical solution of the differential equation from time 0 to t, starting with n1=a, n2=b. ParametricPlot gives a parametric plot (phase plane diagram) of the solution. You should calculate some more examples and plot them on the same graph. You will need to add the arrows manually. ;[s] 5:0,0;14,1;25,0;132,1;146,0;326,-1; 2:3,13,9,Times,0,12,0,0,0;2,13,9,Times,1,12,0,0,0; :[font = input; preserveAspect] sol[a_,b_,time_]:= NDSolve[{n1'[t]==.5(1-(n1[t]+3n2[t]/2)/1000)n1[t], n2'[t]==.5(1-(n2[t]+3n1[t]/2)/1000)n2[t], n1[0]==a,n2[0]==b}, {n1,n2},{t,time}] :[font = input; preserveAspect] example=sol[200,600,20]; :[font = input; preserveAspect; endGroup; endGroup] ParametricPlot[Evaluate[{n1[t],n2[t]}/.example], {t,0,20}, Axes->Automatic, PlotRange->{{0,1500},{0,1500}}] :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 2 :[font = text; inactive; preserveAspect] We first define the two functions representing the differential equations for the Lotka-Volterra competition model. It is convenient to write them as indexed functions: :[font = input; preserveAspect] f[1][n1_,n2_]:=r1(1-(n1+g12 n2)/k1)n1 f[2][n1_,n2_]:=r2(1-(n2+g21 n1)/k2)n2 :[font = text; inactive; preserveAspect] In principle we could find the four sets of equilibria using "Solve" but in practice this takes an inordinate time. However, it is clear that they are the equilibria (i) with both species absent, (ii) with species 1 present and 2 absent, (iii) with species 2 present and 1 absent, and (iv) with both species present. The first three are easy to find. The fourth can be found using "Solve" on the pair of linear equations: :[font = input; preserveAspect] equil=Solve[{1-(n[1]+g12 n[2])/k1 == 0, 1-(n[2]+g21 n[1])/k2 == 0},{n[1],n[2]}] :[font = text; inactive; preserveAspect] (You will see shortly why I am now using indexed variables for n.) The solution has two braces round it, allowing for the possibility of several solutions. We shall use Flatten to remove one of the braces, and at the same time try to simplify the result: ;[s] 3:0,0;169,1;177,0;255,-1; 2:2,13,9,Times,0,12,0,0,0;1,13,9,Times,1,12,0,0,0; :[font = input; preserveAspect] equil=Simplify[Flatten[equil]] :[font = text; inactive; preserveAspect] The matrix of partial derivatives of the functions f[i] with respect to the variables n[j] can be calculated as follows: :[font = input; preserveAspect] jac=Table[D[f[i][n[1],n[2]],n[j]],{i,2},{j,2}] :[font = text; inactive; preserveAspect] It remains to evaluate this matrix at an appropriate equilibrium: :[font = input; preserveAspect] jac/.{n[1]->k1,n[2]->0} :[font = text; inactive; preserveAspect] If necessary use Simplify[] on the result. To put in numerical values for the parameters you may use a second replacement rule: ;[s] 3:0,0;17,1;27,0;128,-1; 2:2,13,9,Times,0,12,0,0,0;1,13,9,Times,1,12,0,0,0; :[font = input; preserveAspect] ans=jac/.equil/.{r1->.5,r2->.5,g12->2/3, g21->2/3,k1->1000,k2->1000} :[font = text; inactive; preserveAspect] To find the eigenvalues and eigenvectors use Eigensystem[]: ;[s] 3:0,0;45,1;58,0;60,-1; 2:2,13,9,Times,0,12,0,0,0;1,13,9,Times,1,12,0,0,0; :[font = input; preserveAspect; endGroup] Eigensystem[ans] :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 3 :[font = text; inactive; preserveAspect] Mathematica is useful to simplify the algebra. I illustrate the most complicated case, that of the internal equilibrium, using jac and equil from the previous exercise. From there on, use pencil and paper. ;[s] 6:0,1;11,0;127,2;131,0;135,2;140,0;206,-1; 3:3,13,9,Times,0,12,0,0,0;1,14,10,Times,2,12,0,0,0;2,13,9,Times,1,12,0,0,0; :[font = input; preserveAspect] mat=jac/.equil; :[font = input; preserveAspect] d=Simplify[Det[mat]] :[font = input; preserveAspect; endGroup] t=Simplify[Sum[mat[[i,i]],{i,2}]] :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 4 :[font = text; inactive; preserveAspect; endGroup] See Exercise 2. :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 5 :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] 5a :[font = text; inactive; preserveAspect] This is also similar to Exercise 2. It is first necessary to clear the old definition of f and then to redefine the functions. :[font = input; preserveAspect] Clear[f] :[font = input; preserveAspect] f[1][n1_,n2_]:=r1 n1(1-n1/k1) - a1 n1 n2/(1+b n1) f[2][n1_,n2_]:=-r2 n2 + a2 n1 n2/(1+b n1) :[font = input; preserveAspect] r1=r2=1;a1=a2=.01;b=.005; :[font = input; preserveAspect] equil={n[1]->200,n[2]->200(1-200/k1)}; :[font = input; preserveAspect] jac=Table[D[f[i][n[1],n[2]],n[j]],{i,2},{j,2}]; :[font = input; preserveAspect] eigen=Eigenvalues[jac/.equil] :[font = input; preserveAspect; endGroup] Plot[Max[Re[eigen]],{k1,201,1000}] :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] 5b :[font = text; inactive; preserveAspect; endGroup; endGroup] See Exercise 1b. :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 6 :[font = text; inactive; preserveAspect] Start, as before, by evaluating the Jacobian matrix at the two equilibria. (I write nn for N and dd for D since capital letters are reserved for built-in functions.) ;[s] 5:0,0;84,1;86,0;97,1;99,0;166,-1; 2:3,13,9,Times,0,12,0,0,0;2,13,9,Times,1,12,0,0,0; :[font = input; preserveAspect] Clear[f] :[font = input; preserveAspect] f[1][x_,y_]:=d(nn - x)+(dd - d)y - beta x y f[2][x_,y_]:=beta x y -(dd + gamma)y :[font = input; preserveAspect] jac=Table[D[f[i][n[1],n[2]],n[j]],{i,2},{j,2}]; :[font = input; preserveAspect] equil={{n[1]->nn,n[2]->0}, {n[1]->(dd+gamma)/beta, n[2]->(nn-(dd+gamma)/beta)/(1+gamma/d)}}; :[font = input; preserveAspect] Simplify[jac/.equil[[1]]]//TableForm :[font = text; inactive; preserveAspect] The determinant is positive when (dd + gamma) > beta nn, in which case the trace is negative. :[font = input; preserveAspect] Simplify[jac/.equil[[2]]]//TableForm :[font = text; inactive; preserveAspect; endGroup] The determinant is positive when (dd + gamma) > beta nn, in which case the trace is negative. :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 7 :[font = text; inactive; preserveAspect] We may use the model of Exercise 6 if we take nn=1, d=dd=1/70, gamma=50, beta=500; I write these in decimal form to force numerical evaluation. :[font = input; preserveAspect] nn=1.; d=dd=1/70.; gamma=50.; beta=500.; :[font = input; preserveAspect] equil[[2]] :[font = input; preserveAspect] Eigenvalues[jac/.%] :[font = input; preserveAspect; endGroup] N[2Pi/Im[%[[1]]]] :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 8 :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] 8a :[font = text; inactive; preserveAspect; endGroup] Use pencil and paper. :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] 8b :[font = text; inactive; preserveAspect] Stability analysis is similar for discrete-time models, but depends on the eigenvalues being less than 1 in absolute value rather than on their real part being negative. :[font = input; preserveAspect] Clear[f] :[font = input; preserveAspect] f[1][n1_,n2_]:=r n1 Exp[-n2] f[2][n1_,n2_]:=n1(1-Exp[-n2]) :[font = input; preserveAspect] equil={n[1]->r Log[r]/(r-1),n[2]->Log[r]}; :[font = input; preserveAspect] eigen=Eigenvalues[Table[D[f[i][n[1],n[2]],n[j]], {i,2},{j,2}]/.equil]; :[font = input; preserveAspect] Plot[Max[Abs[eigen]],{r,1.01,5}] :[font = input; preserveAspect; endGroup] Plot[Im[eigen[[1]]],{r,1.01,5}] :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] 8c :[font = text; inactive; preserveAspect] The following program will iterate the equations using NestList acting on a two-dimensional function. Change the value of R, or the starting values, to obtain different simulations. ;[s] 3:0,0;55,1;63,0;182,-1; 2:2,13,9,Times,0,12,0,0,0;1,13,9,Times,1,12,0,0,0; :[font = input; preserveAspect] g[{n1_,n2_}]:={f[1][n1,n2],f[2][n1,n2]}/.r->2.0 :[font = input; preserveAspect] res=NestList[g,{1.0,1.0},50]; :[font = input; preserveAspect] {h,p}=Transpose[res]; :[font = input; preserveAspect] host=ListPlot[h,PlotJoined->True, PlotRange->All]; :[font = input; preserveAspect] parasitoid=ListPlot[p,PlotJoined->True, PlotRange->All]; :[font = input; preserveAspect; endGroup; endGroup] Show[host,parasitoid] :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 9 :[font = text; inactive; preserveAspect; endGroup; endGroup] See previous exercise. ^*)