(*********************************************************************** 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[ 8188, 254]*) (*NotebookOutlinePosition[ 9242, 290]*) (* CellTagsIndexPosition[ 9198, 286]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{Cell[TextData["CHAPTER 11"], "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[ "Activate the game-theory package and define the appropriate payoff matrix."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["<True], Cell[TextData["A={{.5,0,0},{.8,.4,0},{.64,.64,.32}};\nESStrategy[A]"], "Input", AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["1b, c, d"], "Subsubsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["These parts can be done in a similar way."], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]]}, Open]], Cell[CellGroupData[{Cell[TextData["2"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "There are four genotypes, T1P1, T1P2, T2P1 and T2P2, which we denote as 1, \ 2, 3 and 4. Let x be the vector of their frequencies in a particular \ generation, which will be the same in males and females before viability \ selection acts on males. We first calculate the genotype frequencies in males \ after viability selection, remembering to standardize them to sum to unity: \ "], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "xm[x_]:=Module[{temp},\n\ttemp=Table[If[i<=2,x[[i]],(1-s) x[[i]]],{i,4}];\n\t\ \ttemp/Apply[Plus,temp]]"], "Input", AspectRatioFixed->True], Cell[TextData[ "Next find the frequencies of matings between an i female and a j male, \ remembering to make the total frequency of matings of type i females sum to \ xi:"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "matfreq[x_]:=Module[{m,temp},\n\t\t\tm=xm[x];\n\t\t\t\ temp=Table[x[[i]]*m[[j]]*If[EvenQ[i]&&j>=3,a,1],\n\t\t\t\t{i,4},{j,4}];\n\t\t\ \tDo[temp[[i]]*=x[[i]]/Apply[Plus,temp[[i]]],\n\t\t\t\t\t{i,4}];\n\t\t\ttemp]\ \n\t\t\t "], "Input", AspectRatioFixed->True], Cell[TextData[ "Finally, compute the frequencies of the four different types of offspring \ from these matings under Mendelian inheritance with recombination fraction r \ between the two loci:"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "mendel=Table[0,{4},{4},{4}];\n\ Do[mendel[[i,j,i]]+=1/2;mendel[[i,j,j]]+=1/2,{i,4},{j,4}];\n\ mendel[[1,4]]=mendel[[4,1]]={(1-r),r,r,(1-r)}/2;\n\ mendel[[2,3]]=mendel[[3,2]]={r,(1-r),(1-r),r}/2;\n"], "Input", AspectRatioFixed->True], Cell[TextData[ "The vector of frequencies in the next generation can now be calculated:"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "nextx[x_]:=Sum[matfreq[x][[i,j]] mendel[[i,j]],{i,4},{j,4}];\n\t\t\t"], "Input", AspectRatioFixed->True], Cell[TextData[ "However, it is more informative to do the simulations in terms of the gene \ frequencies for T2, t=x3+x4, and for P2, p=x2+x4, and the coefficient of \ linkage disequilibrium, d=x1x4-x2x3. Note that x1=(1-t)(1-p)+d, \ x2=(1-t)p-d,x3=t(1-p)-d,x4=tp+d. We may therefore write the recurrence for y \ = {t, p ,d} as"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "next[{t_,p_,d_}]:=Module[{x1,x2,x3,x4},\n\t{x1,x2,x3,x4}=nextx[\n\t\t\ {(1-t)(1-p)+d,(1-t)p-d,t(1-p)-d,t*p+d}];\n\t{x3+x4,x2+x4,x1*x4-x2*x3}]\t\t\t\ "], "Input", AspectRatioFixed->True], Cell[TextData[ "We now find the general formula for this recurrence relation, and simplify \ the explicit results for the changes in the two gene frequencies: "], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["res=next[{t,p,d}];"], "Input", AspectRatioFixed->True], Cell[TextData["deltat=Simplify[res[[1]]-t]"], "Input", AspectRatioFixed->True], Cell[TextData["deltap=Simplify[res[[2]]-p]"], "Input", AspectRatioFixed->True], Cell[TextData[ "Thus\n\t\t\t\t\t\t\t\t\t\tt'=t+t(1-t)A\n\t\t\t\t\t\t\t\t\t\tp'=p+dA\n\t\t\t\t\ \t\t\t\t\t\td'=something complicated\nwhere\n\t\t\t\t\t\t\t\t\t\tA=(linear \ function of p and t)/(quadratic function of t)\nas discussed in the text."], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["3"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "Isolate A from Exercise 2 and evaluate it with the given parameter values. \ Set up a simulation using the results in Exercise 2 using ", Evaluatable->False, AspectRatioFixed->True], StyleBox["NestList", Evaluatable->False, AspectRatioFixed->True, FontWeight->"Bold"], StyleBox[".", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["4"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["Adapt Exercises 2 and 3."], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["5"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "Suppose that P2 females have fitness 1-k relative to P1 females. This can \ be incorporated into the model by defining a function ", Evaluatable->False, AspectRatioFixed->True], StyleBox["xf[x_] ", Evaluatable->False, AspectRatioFixed->True, FontWeight->"Bold"], StyleBox["similar to ", Evaluatable->False, AspectRatioFixed->True], StyleBox["xm[x_]", Evaluatable->False, AspectRatioFixed->True, FontWeight->"Bold"], StyleBox[" and changing ", Evaluatable->False, AspectRatioFixed->True], StyleBox["matfreq", Evaluatable->False, AspectRatioFixed->True, FontWeight->"Bold"], StyleBox[".", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "xf[x_]:=Module[{temp},\n\ttemp=Table[If[OddQ[i],x[[i]],(1-k) x[[i]]],{i,4}];\ \n\t\ttemp/Apply[Plus,temp]]"], "Input", AspectRatioFixed->True], Cell[TextData[ "matfreq[x_]:=Module[{m,f,temp},\n\t\t\tm=xm[x];\n\t\t\tf=xf[x];\n\t\t\t\ temp=Table[f[[i]]*m[[j]]*If[EvenQ[i]&&j>=3,a,1],\n\t\t\t\t{i,4},{j,4}];\n\t\t\ \tDo[temp[[i]]*=f[[i]]/Apply[Plus,temp[[i]]],\n\t\t\t\t\t{i,4}];\n\t\t\ttemp]\ \n\t\t\t "], "Input", AspectRatioFixed->True]}, Open]]}, Open]] }, FrontEndVersion->"Macintosh 3.0", ScreenRectangle->{{0, 640}, {0, 460}}, WindowToolbars->{}, CellGrouping->Manual, WindowSize->{520, 365}, WindowMargins->{{4, Automatic}, {Automatic, 31}}, 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, 87, 2, 70, "Section", Evaluatable->False], Cell[CellGroupData[{ Cell[1841, 55, 81, 2, 70, "Subsection", Evaluatable->False], Cell[CellGroupData[{ Cell[1945, 59, 85, 2, 70, "Subsubsection", Evaluatable->False], Cell[2033, 63, 152, 4, 70, "Text", Evaluatable->False], Cell[2188, 69, 67, 1, 70, "Input"], Cell[2258, 72, 105, 1, 70, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[2395, 75, 91, 2, 70, "Subsubsection", Evaluatable->False], Cell[2489, 79, 115, 2, 70, "Text", Evaluatable->False] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[2645, 83, 81, 2, 70, "Subsection", Evaluatable->False], Cell[2729, 87, 456, 8, 70, "Text", Evaluatable->False], Cell[3188, 97, 157, 3, 70, "Input"], Cell[3348, 102, 229, 5, 70, "Text", Evaluatable->False], Cell[3580, 109, 277, 5, 70, "Input"], Cell[3860, 116, 251, 5, 70, "Text", Evaluatable->False], Cell[4114, 123, 250, 5, 70, "Input"], Cell[4367, 130, 149, 4, 70, "Text", Evaluatable->False], Cell[4519, 136, 125, 3, 70, "Input"], Cell[4647, 141, 386, 7, 70, "Text", Evaluatable->False], Cell[5036, 150, 203, 4, 70, "Input"], Cell[5242, 156, 218, 4, 70, "Text", Evaluatable->False], Cell[5463, 162, 71, 1, 70, "Input"], Cell[5537, 165, 80, 1, 70, "Input"], Cell[5620, 168, 80, 1, 70, "Input"], Cell[5703, 171, 307, 6, 70, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[6042, 179, 81, 2, 70, "Subsection", Evaluatable->False], Cell[6126, 183, 449, 15, 70, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[6607, 200, 81, 2, 70, "Subsection", Evaluatable->False], Cell[6691, 204, 98, 2, 70, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[6821, 208, 81, 2, 70, "Subsection", Evaluatable->False], Cell[6905, 212, 801, 29, 70, "Text", Evaluatable->False], Cell[7709, 243, 160, 3, 70, "Input"], Cell[7872, 248, 295, 5, 70, "Input"] }, Closed]] }, Open ]] } ] *) (*********************************************************************** End of Mathematica Notebook file. ***********************************************************************)