(*^ ::[ 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 4 :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 1 :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] 1a :[font = text; inactive; preserveAspect] Set up the Leslie matrix: :[font = input; preserveAspect] L=Table[0,{7},{7}]; :[font = input; preserveAspect] L[[1]]={.32,.57,.57,.57,.57,.57,.57}; L[[2,1]]=.46;L[[3,2]]=.77;L[[4,3]]=.65; L[[5,4]]=.67;L[[6,5]]=.64;L[[7,6]]=.88; :[font = input; preserveAspect] TableForm[L] :[font = text; inactive; preserveAspect] Iterate for 50 generations: :[font = input; preserveAspect] n[0]={10,10,10,10,10,10,10}; Do[n[t]=L.n[t-1],{t,50}] :[font = text; inactive; preserveAspect] Find the total population size, and its ratio in successive generations: :[font = input; preserveAspect] Do[tot[t]=Apply[Plus,n[t]],{t,0,50}] :[font = input; preserveAspect] Table[tot[t]/tot[t-1],{t,50}] :[font = text; inactive; preserveAspect] Find the age distribution in successive generations: :[font = input; preserveAspect] age=Table[100.0 n[t]/tot[t],{t,0,50}]; :[font = input; preserveAspect; endGroup] TableForm[N[age,4]] :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] 1b :[font = text; inactive; preserveAspect] Find the eigenvalues and eigenvectors and display the eigenvalues and their absolute values: :[font = input; preserveAspect] {vals,vecs}=Eigensystem[L]; :[font = input; preserveAspect] vals :[font = input; preserveAspect] Abs[vals] :[font = text; inactive; preserveAspect] Find the stable age distribution from the eigenvector corresponding to the dominant eigenvalue: :[font = input; preserveAspect; endGroup] newage=100 vecs[[1]]/Apply[Plus,vecs[[1]]] :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] 1c :[font = text; inactive; preserveAspect] The left eigenvectors of a matrix are the right eigenvectors of its transpose. :[font = input; preserveAspect] {lvals,lvecs}=Eigensystem[Transpose[L]]; :[font = input; preserveAspect] lvals :[font = input; preserveAspect; endGroup; endGroup] repvalue=lvecs[[1]]/lvecs[[1,1]] :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 2 :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] 2a :[font = text; inactive; preserveAspect] Set up the l[[x]] and m[[x]] vectors and define the function of lambda, f[l] = SlÐx l[[x]] m[[x]]: ;[s] 6:0,0;74,1;75,0;79,1;81,2;84,0;99,-1; 3:3,13,9,Times,0,12,0,0,0;2,14,10,Symbol,0,12,0,0,0;1,18,12,Times,32,10,0,0,0; :[font = input; preserveAspect] temp={.25,.46,.77,.65,.67,.64,.88}; l=Table[Product[temp[[i]],{i,x}],{x,7}]; :[font = input; preserveAspect] m={1.28,2.28,2.28,2.28,2.28,2.28,2.28}; :[font = input; preserveAspect] f[lambda_]:=Sum[lambda^(-x)*l[[x]]*m[[x]],{x,7}] :[font = text; inactive; preserveAspect] Plot this function of l to establish the root approximately, and then use FindRoot to find it exactly given its approximate value: ;[s] 5:0,0;22,1;23,0;74,2;82,0;131,-1; 3:3,13,9,Times,0,12,0,0,0;1,14,10,Symbol,0,12,0,0,0;1,13,9,Times,1,12,0,0,0; :[font = input; preserveAspect] Plot[f[lambda],{lambda,.9,1.1}] :[font = input; preserveAspect; endGroup] FindRoot[f[lambda]==1,{lambda,1}] :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] 2b :[font = input; preserveAspect] c=Table[1.0385^(-x)*l[[x]],{x,7}]; :[font = input; preserveAspect; endGroup; endGroup] c=100 c/Apply[Plus,c] :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 3 :[font = text; inactive; preserveAspect] Calculate the mean age and estimate the annual mortality q and survival p. Hence find the expected numbers at different ages from the geometric distribution. :[font = input; preserveAspect] freq={92,37,22,12,6,3}; :[font = input; preserveAspect] mean=Range[6].freq/172 //N :[font = input; preserveAspect] q=1/mean :[font = input; preserveAspect] p=1-q; :[font = input; preserveAspect] expected=Table[172*q*p^(i-1),{i,6}]; :[font = input; preserveAspect] expected[[6]]+=172-Apply[Plus,expected]; :[font = text; inactive; preserveAspect] The last step adds the expected numbers for ages 7+ to those of age 6. Now print out the the expected distribution to compare with the observed distribution, and calculate the chi-square criterion of goodness of fit. :[font = input; preserveAspect] expected :[font = input; preserveAspect; endGroup] chisquare=Apply[Plus,(freq-expected)^2/expected] :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 4 :[font = text; inactive; preserveAspect; endGroup] See Exercise 1 :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 5 :[font = input; preserveAspect; endGroup] Sum[x*1.0385^(-x)*l[[x]]*m[[x]],{x,7}] :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 6 :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] 6a :[font = text; inactive; preserveAspect] Define f[l] and then solve f[l] = 1; it may be assumed that the root is approximately 1, though you could plot the function to confirm this before using FindRoot. ;[s] 7:0,0;9,1;10,0;29,1;30,0;153,2;161,0;163,-1; 3:4,13,9,Times,0,12,0,0,0;2,14,10,Symbol,0,12,0,0,0;1,13,9,Times,1,12,0,0,0; :[font = input; preserveAspect] f[lambda_]:=.01733 lambda^(-3)/(1-.942 lambda^(-1)) :[font = input; preserveAspect] FindRoot[f[lambda]==1,{lambda,1}] :[font = text; inactive; preserveAspect] Changing the age of first breeding from 3 to 4 years: :[font = input; preserveAspect] f[lambda_]:=.01733*.942 lambda^(-4)/(1-.942 lambda^(-1)) :[font = input; preserveAspect; endGroup] FindRoot[f[lambda]==1,{lambda,1}] :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] 6b :[font = text; inactive; preserveAspect] Define the function g in Equation 31 and then write the vector of parameters as a replacement list: :[font = input; preserveAspect] Clear[l,m,p] :[font = input; preserveAspect] g=l*m*lambda^(-3)/(1-p/lambda); :[font = input; preserveAspect] params={lambda->.9608,l->.0722,m->.24,p->.942}; :[font = text; inactive; preserveAspect] Find the sensitivity of l to changes in m from Equation 29. Note that the differentiation would not have worked if the parameters had been assigned values. ;[s] 3:0,0;24,1;25,0;156,-1; 2:2,13,9,Times,0,12,0,0,0;1,14,10,Symbol,0,12,0,0,0; :[font = input; preserveAspect] -D[g,m]/D[g,lambda]/.params :[font = text; inactive; preserveAspect; endGroup; endGroup; endGroup] Find the sensitivity of l to changes in l and p in the same way. ;[s] 3:0,0;24,1;25,0;65,-1; 2:2,13,9,Times,0,12,0,0,0;1,14,10,Symbol,0,12,0,0,0; ^*)