iteratedMap1D.nb  (1-dimensional)
version 1.5 (2021-03-03) Variables a, x, etc. are made local in the runIteratedMap function.
version 1.4 (2021-01-25) nth iterate added.  Logistic map special a values added, name changed from iteratedMap1.nb to iteratedMap1D.nb
version 1.3
transients added
version 1.2
repeat in “path” list fixed.
version 1.1  
Now uses x instead of p for iterates.
This now features use of TableForm[ ].
Uses a Module

runIteratedMap := Module[{cobwebDiagram, a, x, xm, newx, iterates, initialPoint},
nList = Range[0, nIterations];
x = x0;
Do[x = g[x], {nTransients}];
If[nTransients > 0, Print["Initial point = ", x0, ". Start plotting after ", nTransients, " iterates at x = ", x] ];
initialPoint = Point[{x,x}];
path = {{x, x}};
iterates = {x};  (* this will give the seqence of iterates *)
Do[
newx = g[x];
iterates = AppendTo[iterates, newx];
path = Join[path, {{x, newx}, {newx, newx}}];
x = newx,
{nIterations}  (*Do it this many times *)
];
cobwebDiagram = Plot[{g[x], x}, {x, xMin, xMax}, AspectRatio -> Automatic (* y = x is 45° degree line *), PlotStyle ->{Automatic, Dotted}, Epilog -> {PointSize[Large],initialPoint,Line[path]}
];
Print@TableForm[{nList, iterates}, TableHeadings-> {{"n", "x_n"}, None}];
Show[cobwebDiagram, ImageSize -> 200]
];

aVal = 3.54;  (* Originally a = 3.54.  Change to a = 3.96027 to get a period 4 with a differrent order of (Subscript[x, 1]), (Subscript[x, 2]), (Subscript[x, 3]), (Subscript[x, 4]) *)
g[x_] := aVal x(1-x);
x0 = 0.5;
xMin = 0;
xMax =1;
nTransients = 1000;
nIterations =20;
(* Define parameters before running Module *)
runIteratedMap

1+Sqrt[5.]

The next cell has some preset values of a, and the ability to iterate g(x) =  f(f(...(f(x))...)), the n’th iterate of the logistic map f.

a = 4; (* "full chaos" *)
a = 3.96027; (* near superstable period 4 with different order from map in period doubling sequence *)
a = 3.8318; (* close to superstale period 3 *)
a = 3.8284; (* first period 3 orbit appears (intermittency)  (try 3nd iterate) *)
a = 3.6786; (* band merging, or first appearence of odd periods (try 2nd iterate) *)
a = 3.56995; (* close to the accumulation of period doubling *)
a = 3.4986;  (* near superstable period 4 *)
a = 3.4494; (* 1 + (Sqrt[6]),  Period doubling 2 -> 4 *)
a = 3.23607; (* 1 + (Sqrt[5]), Superstable period 2 *)
a = 3; (* period doubling 1 -> 2 *)
a = 2; (* superstable period 1 *)
nthIterate = 1;
f[x_] := a x(1-x); (* the Logistic map *)
g[x_] := Nest[f,x,nthIterate];  (* the n'th iterate of the Logistic map *)
x0 = 0.1; (* orbit with x0 = 0.5 approaches a stable periodic orbit if one exits for this a value *)
xMin = 0;
xMax =1;
nTransients = 0;
nIterations =30;
(* Define parameters before running Module *)
Print["a = ", a];
runIteratedMap

The next cell shows the period 3 orbit at a =4 in the logistic map.  This uses the conjugacy on pg. 116 of text, and the fact that 2/9 is a period-3 point of the tent map.

g[x_] := 4 x(1-x);
x0 = (1. - Cos[2Pi/9])/2; 
xMin = 0;
xMax =1;
nTransients = 0;
nIterations =8;
(* Define parameters before running Module *)
runIteratedMap

Note:  The 2017.1 web site for MAT 667 has the version of iteratedMap1.nb (Not iteratedMap1D.nb) with a cell that is not a module, for ease of modification.

The following cell is for use with the period doubling explanation

a = 4; (* "full chaos" *)
a = 3.96027; (* near superstable period 4 with different order from map in period doubling sequence *)
a = 3.8318; (* close to superstale period 3 *)
a = 3.8284; (* first period 3 orbit appears (intermittency)  (try 3nd iterate) *)
a = 3.6786; (* band merging, or first appearence of odd periods (try 2nd iterate) *)
a = 3.56995; (* close to the accumulation of period doubling *)
a = 3.4986;  (* near superstable period 4 *)
a = 3.4494; (* 1 + (Sqrt[6]),  Period doubling 2 -> 4 *)
a = 3.23607; (* 1 + (Sqrt[5]), Superstable period 2 *)
a = 3; (* period doubling 1 -> 2 *)
a = 2; (* superstable period 1 *)
a = 3.4986;  (* near superstable period 4 *)
f[x_] := a/2 (1-x^2)-1; (* the *symmetric* Logistic map *)
xStar = (a-2)/a;
g[x_] := -1/xStar f[f[xStar x]]; plotTf = True; (* The doubled function Tf *)
g[x_] := f[f[x]]; plotTf =False ;(* the second iterate of the Logistic map *)
g[x_] := f[x];  plotTf = False; (* Plot y = f(x) *)
x0 = 0; (* orbit with x0 = 0.5 approaches a stable periodic orbit if one exits for this a value *)
xMin = -1;
xMax =1;
nTransients = 0;
nIterations =5;
If[plotTf == True, Print["y = Tf(x) is plotted"], (*else*) Print["y = f(x) or y = f(f(x)) is plotted"] ];
(* Define parameters before running Module *)
Print["a = ", a];
Print["x* = (a-2)/2 = ",xStar];
Print["1/x* = ", 1/xStar];
runIteratedMap