(*^

::[	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; ]
                        Sequences -- Longterm Behavior -- Limits

The (closed) initialization cell below defines a Mathematica  procedure  CobWeb  that can be used to draw cobweb diagrams.  The cell after that illustrates how  CobWeb  is used.  Evaluate that cell now.
;[s]
9:0,2;64,0;115,1;126,0;139,2;145,0;227,2;233,0;245,3;269,-1;
4:4,13,9,Times,0,12,0,0,0;1,13,9,Times,2,12,0,0,0;3,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; ]
f[p_] := 3.4 (1 - .001 p) p

CobWeb[f, 1000.0, 100, 20]
:[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.
;[s]
3:0,0;15,1;21,0;404,-1;
2:2,13,9,Times,0,12,0,0,0;1,13,9,Times,1,12,0,0,0;
:[font = special1; inactive; preserveAspect; ]
The cell below illustrates how Mathematica  can be used to examine the longterm behavior of dynamical systems.  Evaluate that cell now. 
;[s]
5:0,0;31,1;42,0;112,2;136,0;137,-1;
3:3,13,9,Times,0,12,0,0,0;1,13,9,Times,2,12,0,0,0;1,13,9,Times,1,12,65535,0,0;
:[font = input; preserveAspect; ]
Clear[f, pop]

f[p_] := 4.0 (1 - .001 p) p
pop[1] := 50
pop[n_] := f[pop[n - 1]]

CobWeb[f, 1000, 100, 50]

TableForm[Table[{i, pop[i]}, {i, 1, 50}]]

ListPlot[Table[{i, pop[i]}, {i, 1, 50}],
         PlotJoined -> True,
         PlotRange -> {0, 2000}]
^*)