(*^

::[	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 -- Classifying Cycles
                           
The cell below finds the equilibrium points and the 2-cycles for the logistic model
                          
                        p[n + 1] := a (1 - b p[n]) p[n]
                        
Evaluate it now.  Notice that the output is two lists -- EqPoints, a list of equilibrium points -- and AllPoints, a list of the points that are either in 2-cycles or equilibrium points.  The next cell picks one of the 2-cycle points that is not an equilibrium point.  Either one of these true 2-cycle points will do.  That cell was written after looking at the output from the cell immediately below this one.  Evaluate that cell after evaluating the cell immediately below this one and checking that a true 2-cycle point will be chosen.
;[s]
7:0,1;87,0;198,1;279,2;297,3;619,4;688,2;817,-1;
5:1,13,9,Times,0,12,0,0,0;2,13,9,Times,1,12,0,0,0;2,13,9,Times,1,12,65535,0,0;1,13,9,Times,1,12,0,0,65535;1,13,9,Times,1,12,65535,0,65535;
:[font = input; preserveAspect; ]
Clear[f, a, b, AllPoints, EqPoints]

f[p_] := a (1 - b p) p

EqPoints = Table[p /.Solve[f[p] == p, p]];

AllPoints = Table[p /. Solve[f[f[p]] == p, p]];

EqPoints

AllPoints
:[font = input; preserveAspect; ]
(* This cell picks one of the true 2-cycle points.   *)
(* You may have to change it.  It picks one of       *)
(* the solutions of f[f[p]] == p that is not an      *)
(* equilibrium point.                                *)
(*                                                   *)
(* The 3 chooses the third item in the list,         *)
(* AllPoints of solutions of f[f[p]] == p.           *)

Clear[Cycle]

Cycle = AllPoints[[3]] 
;[s]
6:0,1;287,2;288,1;393,0;426,2;427,0;431,-1;
3:2,12,10,Courier,1,12,0,0,0;2,12,10,Courier,1,12,65535,0,0;2,12,10,Courier,1,12,0,0,65535;
:[font = special1; inactive; preserveAspect; ]
The next cell calculates the derivative of the function  f[f[p]]  and then evaluates this derivative at the true 2-cycle point chosen above.  It then looks for places where this derivative is equal to +1 or -1.  Evaluate the next cell now.
;[s]
5:0,0;57,1;65,0;212,2;239,0;240,-1;
3: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;
:[font = input; preserveAspect; ]
Clear[fp]

fp[p_] = D[f[f[p]], p] 
:[font = input; preserveAspect; ]
N[Solve[fp[Cycle] == -1, a]]
N[Solve[fp[Cycle] == 1, a]]
:[font = special1; inactive; preserveAspect; ]
Notice that the derivative at the 2-cycle point is equal to +1 or -1 at the points (roughly)  
a = -1.44949, -1, 3, 3.44949 and that the value of the constant  b  does not appear.  We know from our previous work that the nonzero equilibrium point is no longer attracting when 
a > 3.  The next cell evaluates the derivative at  a = 3.2  and  a = 4 -- two points on either side of  a = 3.44949 using a typical value of b.  Evaluate it now.  Putting all this work together we see that the 2-cycle will be attracting if  3 < a < 3.44949  because the derivative of  f[f[p]] at the true 2-cycle point will be less than one in absolute value in this range.
;[s]
21:0,0;95,1;123,0;160,1;161,0;277,1;282,0;327,1;335,0;341,1;347,0;381,1;392,0;418,1;419,0;422,2;438,0;518,1;533,0;561,1;570,0;651,-1;
3:11,13,9,Times,0,12,0,0,0;9,13,9,Times,1,12,0,0,0;1,13,9,Times,1,12,65535,0,0;
:[font = input; preserveAspect; ]
N[fp[Cycle]] /. {a -> 3.2, b -> .001}
N[fp[Cycle]] /. {a -> 4, b -> .001}
^*)