(*********************************************************************** Mathematica-Compatible Notebook This notebook can be used on any computer system with Mathematica 3.0, MathReader 3.0, or any compatible application. The data for the notebook starts with the line of stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. ***********************************************************************) (*CacheID: 232*) (*NotebookFileLineBreakTest NotebookFileLineBreakTest*) (*NotebookOptionsPosition[ 14656, 496]*) (*NotebookOutlinePosition[ 15711, 532]*) (* CellTagsIndexPosition[ 15667, 528]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{Cell[TextData["CHAPTER 3"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["1"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["1a"], "Subsubsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["Use pencil and paper."], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["1b"], "Subsubsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["The procedure ", Evaluatable->False, AspectRatioFixed->True], StyleBox["sol[a,b,t] ", Evaluatable->False, AspectRatioFixed->True, FontWeight->"Bold"], StyleBox[ "calculates the numerical solution of the differential equation from time 0 \ to t, starting with n1=a, n2=b. ", Evaluatable->False, AspectRatioFixed->True], StyleBox["ParametricPlot", Evaluatable->False, AspectRatioFixed->True, FontWeight->"Bold"], StyleBox[ " 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. ", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "sol[a_,b_,time_]:=\n\tNDSolve[{n1'[t]==.5(1-(n1[t]+3n2[t]/2)/1000)n1[t],\n\t\ \t\tn2'[t]==.5(1-(n2[t]+3n1[t]/2)/1000)n2[t],\n\t\t\tn1[0]==a,n2[0]==b},\n\t\t\ \t{n1,n2},{t,time}]"], "Input", AspectRatioFixed->True], Cell[TextData["example=sol[200,600,20];"], "Input", AspectRatioFixed->True], Cell[TextData[ "ParametricPlot[Evaluate[{n1[t],n2[t]}/.example],\n\t\t\t\t\t{t,0,20},\n\t\t\t\ \tAxes->Automatic,\n\t\t\t\tPlotRange->{{0,1500},{0,1500}}]"], "Input", AspectRatioFixed->True]}, Open]]}, Open]], Cell[CellGroupData[{Cell[TextData["2"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "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: "], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "f[1][n1_,n2_]:=r1(1-(n1+g12 n2)/k1)n1\nf[2][n1_,n2_]:=r2(1-(n2+g21 \ n1)/k2)n2"], "Input", AspectRatioFixed->True], Cell[TextData[ "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:"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "equil=Solve[{1-(n[1]+g12 n[2])/k1 == 0,\n\t\t1-(n[2]+g21 n[1])/k2 == \ 0},{n[1],n[2]}]"], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "(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 ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Flatten ", Evaluatable->False, AspectRatioFixed->True, FontWeight->"Bold"], StyleBox[ "to remove one of the braces, and at the same time try to simplify the \ result:", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[" \nequil=Simplify[Flatten[equil]]"], "Input", AspectRatioFixed->True], Cell[TextData[ "The matrix of partial derivatives of the functions f[i] with respect to the \ variables n[j] can be calculated as follows:"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["jac=Table[D[f[i][n[1],n[2]],n[j]],{i,2},{j,2}]"], "Input", AspectRatioFixed->True], Cell[TextData[ "It remains to evaluate this matrix at an appropriate equilibrium:"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["jac/.{n[1]->k1,n[2]->0}"], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox["If necessary use ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Simplify[]", Evaluatable->False, AspectRatioFixed->True, FontWeight->"Bold"], StyleBox[ " on the result. To put in numerical values for the parameters you may use \ a second replacement rule:", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "ans=jac/.equil/.{r1->.5,r2->.5,g12->2/3,\n\t\t\t\t\t\t\t\ g21->2/3,k1->1000,k2->1000}"], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox["To find the eigenvalues and eigenvectors use ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Eigensystem[]", Evaluatable->False, AspectRatioFixed->True, FontWeight->"Bold"], StyleBox[":", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["Eigensystem[ans]"], "Input", AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["3"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ " is useful to simplify the algebra. I illustrate the most complicated \ case, that of the internal equilibrium, using ", Evaluatable->False, AspectRatioFixed->True], StyleBox["jac ", Evaluatable->False, AspectRatioFixed->True, FontWeight->"Bold"], StyleBox["and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["equil", Evaluatable->False, AspectRatioFixed->True, FontWeight->"Bold"], StyleBox[ " from the previous exercise. From there on, use pencil and paper.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["mat=jac/.equil;"], "Input", AspectRatioFixed->True], Cell[TextData["d=Simplify[Det[mat]]"], "Input", AspectRatioFixed->True], Cell[TextData["t=Simplify[Sum[mat[[i,i]],{i,2}]]"], "Input", AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["4"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["See Exercise 2."], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["5"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["5a"], "Subsubsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "This is also similar to Exercise 2. It is first necessary to clear the old \ definition of f and then to redefine the functions."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["Clear[f]"], "Input", AspectRatioFixed->True], Cell[TextData[ "f[1][n1_,n2_]:=r1 n1(1-n1/k1) - a1 n1 n2/(1+b n1)\nf[2][n1_,n2_]:=-r2 n2 + \ a2 n1 n2/(1+b n1)"], "Input", AspectRatioFixed->True], Cell[TextData["r1=r2=1;a1=a2=.01;b=.005;"], "Input", AspectRatioFixed->True], Cell[TextData["equil={n[1]->200,n[2]->200(1-200/k1)};"], "Input", AspectRatioFixed->True], Cell[TextData["jac=Table[D[f[i][n[1],n[2]],n[j]],{i,2},{j,2}];"], "Input", AspectRatioFixed->True], Cell[TextData["eigen=Eigenvalues[jac/.equil]"], "Input", AspectRatioFixed->True], Cell[TextData["Plot[Max[Re[eigen]],{k1,201,1000}]"], "Input", AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["5b"], "Subsubsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["See Exercise 1b."], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]]}, Open]], Cell[CellGroupData[{Cell[TextData["6"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "Start, as before, by evaluating the Jacobian matrix at the two equilibria. \ (I write ", Evaluatable->False, AspectRatioFixed->True], StyleBox["nn", Evaluatable->False, AspectRatioFixed->True, FontWeight->"Bold"], StyleBox[" for N and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["dd", Evaluatable->False, AspectRatioFixed->True, FontWeight->"Bold"], StyleBox[ " for D since capital letters are reserved for built-in functions.)", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["Clear[f]"], "Input", AspectRatioFixed->True], Cell[TextData[ "f[1][x_,y_]:=d(nn - x)+(dd - d)y - beta x y\nf[2][x_,y_]:=beta x y -(dd + \ gamma)y"], "Input", AspectRatioFixed->True], Cell[TextData["jac=Table[D[f[i][n[1],n[2]],n[j]],{i,2},{j,2}];"], "Input", AspectRatioFixed->True], Cell[TextData[ "equil={{n[1]->nn,n[2]->0},\n\t\t\t{n[1]->(dd+gamma)/beta,\n\t\t\ n[2]->(nn-(dd+gamma)/beta)/(1+gamma/d)}};"], "Input", AspectRatioFixed->True], Cell[TextData["Simplify[jac/.equil[[1]]]//TableForm"], "Input", AspectRatioFixed->True], Cell[TextData[ "The determinant is positive when (dd + gamma) > beta nn, in which case the \ trace is negative."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["Simplify[jac/.equil[[2]]]//TableForm"], "Input", AspectRatioFixed->True], Cell[TextData[ "The determinant is positive when (dd + gamma) > beta nn, in which case the \ trace is negative."], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["7"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "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."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["nn=1.;\nd=dd=1/70.;\ngamma=50.;\nbeta=500.;"], "Input", AspectRatioFixed->True], Cell[TextData["equil[[2]]"], "Input", AspectRatioFixed->True], Cell[TextData["Eigenvalues[jac/.%]"], "Input", AspectRatioFixed->True], Cell[TextData["N[2Pi/Im[%[[1]]]]"], "Input", AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["8"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["8a"], "Subsubsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["Use pencil and paper."], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["8b"], "Subsubsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "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."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["Clear[f]"], "Input", AspectRatioFixed->True], Cell[TextData[ "f[1][n1_,n2_]:=r n1 Exp[-n2]\nf[2][n1_,n2_]:=n1(1-Exp[-n2])"], "Input", AspectRatioFixed->True], Cell[TextData["equil={n[1]->r Log[r]/(r-1),n[2]->Log[r]};"], "Input", AspectRatioFixed->True], Cell[TextData[ "eigen=Eigenvalues[Table[D[f[i][n[1],n[2]],n[j]],\n\t\t\ {i,2},{j,2}]/.equil];"], "Input", AspectRatioFixed->True], Cell[TextData["Plot[Max[Abs[eigen]],{r,1.01,5}]"], "Input", AspectRatioFixed->True], Cell[TextData["Plot[Im[eigen[[1]]],{r,1.01,5}]"], "Input", AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["8c"], "Subsubsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["The following program will iterate the equations using ", Evaluatable->False, AspectRatioFixed->True], StyleBox["NestList", Evaluatable->False, AspectRatioFixed->True, FontWeight->"Bold"], StyleBox[ " acting on a two-dimensional function. Change the value of R, or the \ starting values, to obtain different simulations.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["g[{n1_,n2_}]:={f[1][n1,n2],f[2][n1,n2]}/.r->2.0"], "Input", AspectRatioFixed->True], Cell[TextData["res=NestList[g,{1.0,1.0},50];"], "Input", AspectRatioFixed->True], Cell[TextData["{h,p}=Transpose[res];"], "Input", AspectRatioFixed->True], Cell[TextData[ "host=ListPlot[h,PlotJoined->True,\n\t\tPlotRange->All];"], "Input", AspectRatioFixed->True], Cell[TextData[ "parasitoid=ListPlot[p,PlotJoined->True,\n\t\tPlotRange->All];"], "Input", AspectRatioFixed->True], Cell[TextData["Show[host,parasitoid]"], "Input", AspectRatioFixed->True]}, Open]]}, Open]], Cell[CellGroupData[{Cell[TextData["9"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["See previous exercise."], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]]}, Open]] }, FrontEndVersion->"Macintosh 3.0", ScreenRectangle->{{0, 640}, {0, 460}}, WindowToolbars->{}, CellGrouping->Manual, WindowSize->{520, 365}, WindowMargins->{{52, Automatic}, {15, Automatic}}, PrivateNotebookOptions->{"ColorPalette"->{RGBColor, -1}}, ShowCellLabel->True, ShowCellTags->False, RenderingOptions->{"ObjectDithering"->True, "RasterDithering"->False}, MacintoshSystemPageSetup->"\<\ AVU/IFiQKFD000000V:^/09R]g0000000OVaH097bCP0AP1Y06`0I@1^0642HZj` 0V:gT0000001nK500TO9>000000000000000009R[[0000000000000000000000 00000000000000000000000000000000\>" ] (*********************************************************************** Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. ***********************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[1731, 51, 86, 2, 70, "Section", Evaluatable->False], Cell[CellGroupData[{ Cell[1840, 55, 81, 2, 70, "Subsection", Evaluatable->False], Cell[CellGroupData[{ Cell[1944, 59, 85, 2, 70, "Subsubsection", Evaluatable->False], Cell[2032, 63, 95, 2, 70, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[2159, 67, 85, 2, 70, "Subsubsection", Evaluatable->False], Cell[2247, 71, 799, 25, 70, "Text", Evaluatable->False], Cell[3049, 98, 231, 4, 70, "Input"], Cell[3283, 104, 77, 1, 70, "Input"], Cell[3363, 107, 192, 3, 70, "Input"] }, Closed]] }, Open ]], Cell[CellGroupData[{ Cell[3596, 112, 81, 2, 70, "Subsection", Evaluatable->False], Cell[3680, 116, 248, 5, 70, "Text", Evaluatable->False], Cell[3931, 123, 132, 3, 70, "Input"], Cell[4066, 128, 510, 8, 70, "Text", Evaluatable->False], Cell[4579, 138, 140, 3, 70, "Input"], Cell[4722, 143, 568, 18, 70, "Text", Evaluatable->False], Cell[5293, 163, 86, 1, 70, "Input"], Cell[5382, 166, 197, 4, 70, "Text", Evaluatable->False], Cell[5582, 172, 99, 1, 70, "Input"], Cell[5684, 175, 140, 3, 70, "Text", Evaluatable->False], Cell[5827, 180, 76, 1, 70, "Input"], Cell[5906, 183, 434, 15, 70, "Text", Evaluatable->False], Cell[6343, 200, 139, 3, 70, "Input"], Cell[6485, 205, 361, 13, 70, "Text", Evaluatable->False], Cell[6849, 220, 69, 1, 70, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[6950, 223, 81, 2, 70, "Subsection", Evaluatable->False], Cell[7034, 227, 768, 27, 70, "Text", Evaluatable->False], Cell[7805, 256, 68, 1, 70, "Input"], Cell[7876, 259, 73, 1, 70, "Input"], Cell[7952, 262, 86, 1, 70, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[8070, 265, 81, 2, 70, "Subsection", Evaluatable->False], Cell[8154, 269, 89, 2, 70, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[8275, 273, 81, 2, 70, "Subsection", Evaluatable->False], Cell[CellGroupData[{ Cell[8379, 277, 85, 2, 70, "Subsubsection", Evaluatable->False], Cell[8467, 281, 203, 4, 70, "Text", Evaluatable->False], Cell[8673, 287, 61, 1, 70, "Input"], Cell[8737, 290, 148, 3, 70, "Input"], Cell[8888, 295, 78, 1, 70, "Input"], Cell[8969, 298, 91, 1, 70, "Input"], Cell[9063, 301, 100, 1, 70, "Input"], Cell[9166, 304, 82, 1, 70, "Input"], Cell[9251, 307, 87, 1, 70, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[9370, 310, 85, 2, 70, "Subsubsection", Evaluatable->False], Cell[9458, 314, 90, 2, 70, "Text", Evaluatable->False] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[9589, 318, 81, 2, 70, "Subsection", Evaluatable->False], Cell[9673, 322, 635, 23, 70, "Text", Evaluatable->False], Cell[10311, 347, 61, 1, 70, "Input"], Cell[10375, 350, 137, 3, 70, "Input"], Cell[10515, 355, 100, 1, 70, "Input"], Cell[10618, 358, 160, 3, 70, "Input"], Cell[10781, 363, 89, 1, 70, "Input"], Cell[10873, 366, 170, 4, 70, "Text", Evaluatable->False], Cell[11046, 372, 89, 1, 70, "Input"], Cell[11138, 375, 170, 4, 70, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[11340, 381, 81, 2, 70, "Subsection", Evaluatable->False], Cell[11424, 385, 223, 5, 70, "Text", Evaluatable->False], Cell[11650, 392, 96, 1, 70, "Input"], Cell[11749, 395, 63, 1, 70, "Input"], Cell[11815, 398, 72, 1, 70, "Input"], Cell[11890, 401, 70, 1, 70, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[11992, 404, 81, 2, 70, "Subsection", Evaluatable->False], Cell[CellGroupData[{ Cell[12096, 408, 85, 2, 70, "Subsubsection", Evaluatable->False], Cell[12184, 412, 95, 2, 70, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[12311, 416, 85, 2, 70, "Subsubsection", Evaluatable->False], Cell[12399, 420, 248, 5, 70, "Text", Evaluatable->False], Cell[12650, 427, 61, 1, 70, "Input"], Cell[12714, 430, 113, 2, 70, "Input"], Cell[12830, 434, 95, 1, 70, "Input"], Cell[12928, 437, 131, 3, 70, "Input"], Cell[13062, 442, 85, 1, 70, "Input"], Cell[13150, 445, 84, 1, 70, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[13266, 448, 85, 2, 70, "Subsubsection", Evaluatable->False], Cell[13354, 452, 488, 15, 70, "Text", Evaluatable->False], Cell[13845, 469, 100, 1, 70, "Input"], Cell[13948, 472, 82, 1, 70, "Input"], Cell[14033, 475, 74, 1, 70, "Input"], Cell[14110, 478, 109, 2, 70, "Input"], Cell[14222, 482, 115, 2, 70, "Input"], Cell[14340, 486, 74, 1, 70, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[14455, 489, 81, 2, 70, "Subsection", Evaluatable->False], Cell[14539, 493, 96, 2, 70, "Text", Evaluatable->False] }, Closed]] }, Open ]] } ] *) (*********************************************************************** End of Mathematica Notebook file. ***********************************************************************)