(*^ ::[ 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 11 :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 1 :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] 1a :[font = text; inactive; preserveAspect] Activate the game-theory package and define the appropriate payoff matrix. :[font = input; preserveAspect] <=3,a,1], {i,4},{j,4}]; Do[temp[[i]]*=x[[i]]/Apply[Plus,temp[[i]]], {i,4}]; temp] :[font = text; inactive; preserveAspect] 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: :[font = input; preserveAspect] mendel=Table[0,{4},{4},{4}]; Do[mendel[[i,j,i]]+=1/2;mendel[[i,j,j]]+=1/2,{i,4},{j,4}]; mendel[[1,4]]=mendel[[4,1]]={(1-r),r,r,(1-r)}/2; mendel[[2,3]]=mendel[[3,2]]={r,(1-r),(1-r),r}/2; :[font = text; inactive; preserveAspect] The vector of frequencies in the next generation can now be calculated: :[font = input; preserveAspect] nextx[x_]:=Sum[matfreq[x][[i,j]] mendel[[i,j]],{i,4},{j,4}]; :[font = text; inactive; preserveAspect] 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 :[font = input; preserveAspect] next[{t_,p_,d_}]:=Module[{x1,x2,x3,x4}, {x1,x2,x3,x4}=nextx[ {(1-t)(1-p)+d,(1-t)p-d,t(1-p)-d,t*p+d}]; {x3+x4,x2+x4,x1*x4-x2*x3}] :[font = text; inactive; preserveAspect] We now find the general formula for this recurrence relation, and simplify the explicit results for the changes in the two gene frequencies: :[font = input; preserveAspect] res=next[{t,p,d}]; :[font = input; preserveAspect] deltat=Simplify[res[[1]]-t] :[font = input; preserveAspect] deltap=Simplify[res[[2]]-p] :[font = text; inactive; preserveAspect; endGroup] Thus t'=t+t(1-t)A p'=p+dA d'=something complicated where A=(linear function of p and t)/(quadratic function of t) as discussed in the text. :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 3 :[font = text; inactive; preserveAspect; endGroup] Isolate A from Exercise 2 and evaluate it with the given parameter values. Set up a simulation using the results in Exercise 2 using NestList. ;[s] 3:0,0;133,1;141,0;143,-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] 4 :[font = text; inactive; preserveAspect; endGroup] Adapt Exercises 2 and 3. :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 5 :[font = text; inactive; preserveAspect] Suppose that P2 females have fitness 1-k relative to P1 females. This can be incorporated into the model by defining a function xf[x_] similar to xm[x_] and changing matfreq. ;[s] 7:0,0;128,1;135,0;146,1;152,0;166,1;173,0;175,-1; 2:4,13,9,Times,0,12,0,0,0;3,13,9,Times,1,12,0,0,0; :[font = input; preserveAspect] xf[x_]:=Module[{temp}, temp=Table[If[OddQ[i],x[[i]],(1-k) x[[i]]],{i,4}]; temp/Apply[Plus,temp]] :[font = input; preserveAspect; endGroup; endGroup] matfreq[x_]:=Module[{m,f,temp}, m=xm[x]; f=xf[x]; temp=Table[f[[i]]*m[[j]]*If[EvenQ[i]&&j>=3,a,1], {i,4},{j,4}]; Do[temp[[i]]*=f[[i]]/Apply[Plus,temp[[i]]], {i,4}]; temp] ^*)