(*^ ::[ frontEndVersion = "Macintosh Mathematica Notebook Front End Version 2.1"; macintoshStandardFontEncoding; paletteColors = 128; automaticGrouping; currentKernel; 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"; ; ] :[font = special1; inactive; preserveAspect; ] Age Dependent Population Models The cell below defines the first example in this module. Evaluate it now. ;[s] 4:0,1;64,0;124,2;139,0;142,-1; 3:2,13,9,Times,0,12,0,0,0;1,13,9,Times,1,12,0,0,0;1,13,9,Times,1,12,65535,0,0; :[font = input; preserveAspect; ] Clear[a, b, c, d, e] a[n_] := a[n] = 0.50 * a[n-1] + 1.50 * b[n-1] + 1.50 * c[n-1] + 1.00 * d[n-1] + 0.50 * e[n-1] b[n_] := b[n] = 0.80 * a[n-1] c[n_] := c[n] = 0.95 * b[n-1] d[n_] := d[n] = 0.85 * c[n-1] e[n_] := e[n] = 0.65 * d[n-1] a[1] := 150 b[1] := 145 c[1] := 140 d[1] := 125 e[1] := 100 TableForm[Table[ {a[n], b[n], c[n], d[n], e[n]}, {n, 1, 10}]] :[font = special1; inactive; preserveAspect; ] It is worthwhile to keep track of the total population and the percentage of the population in each age group. The following cell does just that. Evaluate it now. ;[s] 3:0,0;148,1;165,0;168,-1; 2:2,13,9,Times,0,12,0,0,0;1,13,9,Times,1,12,65535,0,0; :[font = input; preserveAspect; ] total[n_] := a[n] + b[n] + c[n] + d[n] + e[n] pcta[n_] := 100 * a[n]/total[n] pctb[n_] := 100 * b[n]/total[n] pctc[n_] := 100 * c[n]/total[n] pctd[n_] := 100 * d[n]/total[n] pcte[n_] := 100 * e[n]/total[n] TableForm[Table[total[n], {n, 1, 20}]] TableForm[Table[ {pcta[n], pctb[n], pctc[n], pctd[n], pcte[n]}, {n, 1, 20}]] :[font = special1; inactive; preserveAspect; ] It is also worthwhile to keep track of the ratio of the total population in each year to the total population the preceding year. The following cell does that. Evaluate it now. ;[s] 3:0,0;163,1;178,0;181,-1; 2:2,13,9,Times,0,12,0,0,0;1,13,9,Times,1,12,65535,0,0; :[font = input; preserveAspect; ] ratio[n_] := total[n+1]/total[n] TableForm[Table[{ratio[n]}, {n, 1, 20}]] :[font = special1; inactive; preserveAspect; ] Based on the evidence above it appears that for this particular model over the long term the population rises by roughly 73% each year and the age distribution stabilizes at about Percent of population in first year .......... 53 Percent of population in second year .......... 25 Percent of population in third year .......... 13 Percent of population in fourth year .......... 7 Percent of population in fifth year .......... 3 ;[s] 2:0,0;182,1;448,-1; 2:1,13,9,Times,0,12,0,0,0;1,13,10,Courier,0,12,0,0,0; ^*)