(*^ ::[ 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 10 :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 1 :[font = text; inactive; preserveAspect] Define the transition matrix, find its dominant eigenvalue, and plot it. :[font = input; preserveAspect] matrix[r_,s_]:={{(1-s)/(2(1-r)),1/2},{s/(2r),1/2}} :[font = input; preserveAspect] eigen[r_,s_]:=Eigenvalues[matrix[r,s]] :[font = input; preserveAspect] lambda[r_,s_]:=Max[eigen[r,s]] :[font = input; preserveAspect; endGroup] Do[Plot[lambda[r,s],{s,0,1}],{r,0.4,0.6,0.1}] :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 2 :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] 2a :[font = text; inactive; preserveAspect] Simplify the first order Taylor series expansion for the eigenvalues. [Notes: 1. Mathematica will only do the algebraic simplification if the transition matrix has been set up with exact rather than numerical expressions. 2. See the caution about the use of PowerExpand in the Mathematica book; in the present case it reverses the two eigenvalues.] ;[s] 7:0,0;81,1;92,0;258,2;269,0;277,1;288,0;349,-1; 3:4,13,9,Times,0,12,0,0,0;2,13,9,Times,2,12,0,0,0;1,13,9,Times,1,12,0,0,0; :[font = input; preserveAspect] Series[eigen[r,s],{s,r,1}] :[font = input; preserveAspect] Simplify[%] :[font = input; preserveAspect] PowerExpand[%] :[font = input; preserveAspect; endGroup] Simplify[%] :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] 2b :[font = input; preserveAspect] y=D[Det[matrix[r,s]-IdentityMatrix[2]],s] :[font = input; preserveAspect; endGroup; endGroup] Solve[y==0,r] :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 3 :[font = text; inactive; preserveAspect] Define the inclusive fitness and use it to find the optimal sex ratio and to check the criteria for stability. (Compare Exercise 8.11.) :[font = input; preserveAspect] Clear[r,s] w=(r+(1-2r)s)/(2r(1-r)); :[font = input; preserveAspect] Solve[(D[w,s]/.s->r)==0] :[font = input; preserveAspect] D[w,{s,2}]/.{s->1/2,r->1/2} :[font = input; preserveAspect; endGroup] D[w,{s,2}]+D[w,s,r]/.{s->1/2,r->1/2} :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 4 :[font = text; inactive; preserveAspect; endGroup] Redefine matrix and then repeat the calculations in the solutions to Exercises 1 and 2. ;[s] 3:0,0;9,1;15,0;88,-1; 2:2,13,9,Times,0,12,0,0,0;1,13,9,Times,1,12,0,0,0; :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 5 :[font = text; inactive; preserveAspect] Female genotypes aa, Aa, AA are numbered 1, 2, 3; male genotypes a, A are 4 and 5. The six mating types {1x1, 2x1, 3x1, 1x2, 2x2, 3x2} are numbered 1 through 6. I first generate a 6x5 matrix m giving the frequencies of offspring from the different matingtypes, with sex ratios produced by aa, Aa and AA females being r, s and t respectively: :[font = input; preserveAspect] m[r_,s_,t_] = {{1-r,0.,0.,r,0.},{.5(1-s),.5(1-s),0.,.5s,.5s}, {0.,1-t,0.,0.,t},{0.,1-r,0.,r,0.}, {0.,.5(1-s),.5(1-s),.5s,.5s},{0.,0.,1-t,0.,t}}; :[font = text; inactive; preserveAspect] I next generate the frequencies of the six mating types, mat, in generation t given the genotype frequencies p1 through p5, with p1+p2+p3=1 and p4+p5=1 and then the standardized genotype frequencies in the next generation: :[font = input; preserveAspect] mat[p_]:=Flatten[Table[p[[i]]*p[[j+3]],{j,2},{i,3}]]; pnext[p_]:=(a=mat[p].m[r,s,t]; a1=Sum[a[[i]],{i,3}]; a2=Sum[a[[i]],{i,4,5}]; Do[a[[i]]/=If[i<=3,a1,a2],{i,5}]; a) :[font = text; inactive; preserveAspect; endGroup] Simulations can be done by using NestList on the function pnext. :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 6, 7 :[font = text; inactive; preserveAspect; endGroup] Use pencil and paper. :[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; endGroup; endGroup] See the solution to Exercise 3. :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 9 :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] 9a :[font = text; inactive; preserveAspect; endGroup] Use pencil and paper. :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] 9b :[font = text; inactive; preserveAspect] I reproduce the argument of Taylor and Bulmer (1980) for obtaining the predicted sex ratio under local mate competition in haplodiploids. Postulate a rare allele A and a wild type allele a acting in females. Because the population structure leads to inbreeding we have to consider AA as well as Aa females, and we suppose that A is dominant to a so that both these types of female have sex ratio s, while aa females have sex ratio r. (The argument can be repeated with different genetic assumptions and leads to the same result.) There are six types of mated female, {0,0}, {0,1}, {1,0}, {1,1}, {2,0} and {2,1}, where {i,j} denotes i A genes in the female and j A genes in the sperm in her spermatheca derived from her mate. (I assume single mating.) Denote these types of mated female 0 through 5; type 0 is common and types 1 through 5 are rare. We therefore need to consider six types of patch, types 1 through 5 with 1 mated female of type k (k going from 1 through 5) and n-1 females of type 0 and patch type 0 with n mated females of type 0. Write pk(t) for the frequency of patch type k in generation t, assumed small for k = 1 through 5. We must now find the linearized recurrence relationship for these five frequencies. The function output[k] takes a patch of type k and calculates the frequencies of the different types of mutant mated females produced by this patch as follows. i and j are the numbers of A genes in the mutant foundress and her sperm respectively, and sr is the sex ratio among her offspring. f[] is the number of female offspring with 0, 1 and 2 A genes produced by the patch. (f should be multiplied by N, the total number of offspring produced by each foundress, but this cancels later and can be ignored.) m[] is the proportion of males with 0 or 1 A genes produced by the patch. Random mating within the patch then produces the result returned by the function. ;[s] 15:0,0;1055,1;1056,0;1254,2;1264,0;1532,2;1536,0;1544,3;1550,0;1619,2;1620,0;1750,2;1754,0;1761,3;1771,0;1907,-1; 4:8,13,9,Times,0,12,0,0,0;1,21,13,Times,64,12,0,0,0;4,13,9,Times,1,12,0,0,0;2,13,9,Times,2,12,0,0,0; :[font = input; preserveAspect] output[k_]:=Module[{i,j,a,b}, j=If[EvenQ[k],0,1]; i=(k-j)/2; sr=If[i==0,r,s]; f[0]=(n-1)(1-r)+(1-sr)(1-j)(1-i/2); f[1]=(1-sr)(j(1-i/2)+(1-j)i/2); f[2]=(1-sr)j i/2; m[1]=(sr i/2)/((n-1)r + sr); m[0]=1-m[1]; Rest[Flatten[Table[f[a] m[b],{a,0,2},{b,0,1}]]]] :[font = text; inactive; preserveAspect] N output[k] pk(t) gives the number of mated females of different mutant types produced by patches of type k in generation t. Dividing by Nn(1-r), which is to first order the total number of mated females produced, gives the relative frequency of the different mutant types of mated female produced by patches of type k. This must be multiplied by n to give the relative frequency of patches of different mutant types in the next generation whose mutant foundress came from a patch of type k in this generation (since each such patch contains 1 mutant foundress in a group of n foundresses). Thus output[k]/(1-r) is the kth column in the transition matrix. We calculate this matrix as: ;[s] 3:0,0;13,1;14,0;685,-1; 2:2,13,9,Times,0,12,0,0,0;1,21,13,Times,64,12,0,0,0; :[font = input; preserveAspect] A=Transpose[Table[output[k]/(1-r),{k,5}]]; :[font = text; inactive; preserveAspect] We now use Equation 10.6 to find the unbeatable sex ratio: :[font = input; preserveAspect] deriv=Simplify[D[Det[A-IdentityMatrix[5]],s]/.s->r] :[font = input; preserveAspect] ans=r/.Solve[deriv==0,r] :[font = input; preserveAspect; endGroup; endGroup] Factor[Numerator[ans]]/Factor[Denominator[ans]] :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 10 :[font = text; inactive; preserveAspect; endGroup] See the solution to Exercise 3. :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 11 :[font = text; inactive; preserveAspect] Define a in Equation 43 as a function of the list of sex ratios in the three patches, r. (The relative frequencies of the patches can be ignored since they are equally frequent.) ;[s] 3:0,0;7,1;8,0;179,-1; 2:2,13,9,Times,0,12,0,0,0;1,18,13,Symbol,0,12,0,0,0; :[font = input; preserveAspect] wmale={1,1,1}; wfemale={1,2,3}; rho=wmale/wfemale; alpha[r_List]:=wmale.r/(wfemale.(1-r)) :[font = text; inactive; preserveAspect] Solve Equation 43 for the optimal sex ratio in the switch patch, assuming in turn that this is the first, second and third patch. See which assumption gives a legitimate answer. :[font = input; preserveAspect] r={x,0,0}; Solve[alpha[r]==rho[[1]],x] :[font = input; preserveAspect] r={1,x,0}; Solve[alpha[r]==rho[[2]],x] :[font = input; preserveAspect; endGroup] r={1,1,x}; Solve[alpha[r]==rho[[3]],x] :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 12 :[font = text; inactive; preserveAspect; endGroup; endGroup] Use pencil and paper. ^*)