(*^

::[	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 -- Cobweb Diagrams

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]
9:0,2;68,0;119,1;130,0;143,2;149,0;352,2;358,0;370,3;394,-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;
^*)