(*^

::[	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; ]
                                                      Stability

This lab is almost identical to the lab for the preceding module.  Although this module is essentially theoretical, we are interested in theory because of what it tells us about particular models.  Thus, you may want to verify experimentally the predictions of the theorems in this module. Logistic models are good examples because it is easy to determine the appropriate derivatives.  At the end of this lab we have added a cell illustrating the way in which Mathematica  can be used to work with sums like geometric series.

The cell below defines a typical logistic model and illustrates how Mathematica can be used to find its equilibrium points and to plot and print some results.  Evaluate that cell now.
;[s]
7:0,1;63,0;525,3;536,0;660,3;671,0;752,2;776,-1;
4:3,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;2,13,9,Times,2,12,0,0,0;
:[font = input; preserveAspect; ]
f[p_] := a (1 - p / c) p

a := 3.0
c := 1000.0

Solve[f[p] == p, p]

pop[1] := 50.0
pop[n_] := f[pop[n-1]]
ListPlot[Table[{i, pop[i]}, {i, 1, 40}],
         PlotRange -> {0, 1000},
         PlotJoined -> True]
         
MatrixForm[Table[{i, pop[i]}, {i, 1, 40}]]
:[font = special1; inactive; preserveAspect; ]
The (closed) initialization cell below defines a Mathematica  procedure  CobWeb  that can be used to draw cobweb diagrams.  An initialization cell, like the one below, is automatically evaluated when the notebook is loaded.  The next cell after the evaluation cell illustrates how  CobWeb  is used.  Evaluate that cell now.
;[s]
8:0,0;49,1;60,0;73,2;79,0;282,2;288,0;300,3;324,-1;
4:4,13,9,Times,0,12,0,0,0;1,13,9,Times,2,12,0,0,0;2,13,9,Times,1,12,0,0,0;1,13,9,Times,1,12,65535,0,0;
:[font = input; initialization; closed; preserveAspect; ]
*)
CobWeb[foo_, high_, a_, n_] :=
 Block[{web = {}},
   For[x = a; i = 1, i < n, ++i; x = foo[x],
       web = Join[Bounce[foo, x], web]];
   Show[Plot[{foo[p], p}, {p, 0, high},
                          PlotStyle -> {RGBColor[1, 0, 0],
                                        RGBColor[0, 0, 0]},
                          DisplayFunction -> Identity],
        Graphics[{PointSize[0.02], 
        {Line[{{a, 0}, {a, foo[a]}}],
        Point[{a, foo[a]}]},
        web
        }],
        AspectRatio -> Automatic,
        PlotRange -> {0, high},
        Axes -> Automatic,
        DisplayFunction -> $DisplayFunction]]
        
Bounce[foo_, a_] := {Line[{{a, foo[a]}, 
                           {foo[a], foo[a]},
                           {foo[a], foo[foo[a]]}}],
                     Point[{foo[a], foo[foo[a]]}]}

(*
:[font = input; preserveAspect; ]
CobWeb[f, 1000.0, 100, 40]
:[font = special1; inactive; preserveAspect; ]
The procedure  CobWeb  requires four parameters.

1.   The name of the function that describes the dynamical system.  Notice that this function must be defined in a separate line.

2.    The highest value of the terms in the sequence.  The horizontal and vertical axes always start at zero and go up to this value.

3.     The initial value of the sequence.

4.    The number of generations to be drawn.

The following cell illustrates the Mathematica  Sum notation.
;[s]
7:0,0;15,1;21,0;440,2;451,0;453,1;456,0;467,-1;
3:4,13,9,Times,0,12,0,0,0;2,13,9,Times,1,12,0,0,0;1,13,9,Times,2,12,0,0,0;
:[font = input; preserveAspect; ]
Sum[2^k, {k, 0, 10}]
^*)