Period3Iterates.nb.
Based on iteratedMap1.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},
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]
];

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[2 Pi/9])/2;
xMin = 0;
xMax =1;
nTransients = 0;
nIterations =3;
(* Define parameters before running Module *)
runIteratedMap
(* Only run this definition in THIS cell *)
x1 = iterates[[1]];
x2 = iterates[[2]];
x3 = iterates[[3]];
symbol[x_] := Which[x ≥ x1 && x ≤  x2, "L", x > x2 && x ≤ x3, "R", True, "O"]
itinerary[orbit_] := Module[{out = ""},
Do[out = out<>symbol[orbit[[i]] ], {i, Length[orbit]}];
out];
Print["itinerary = ",itinerary[iterates] ]

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

g[x_] := 4 x(1-x);
x0 = (1. - Cos[6 Pi/17])/2;  (* that can be 2Pi/17 or 2Pi/15 or 6 Pi/17 for the three period 4 orbits *)
xMin = 0;
xMax =1;
nTransients = 0;
nIterations =10;
(* Define parameters before running Module *)
runIteratedMap
Print["itinerary = ",itinerary[iterates] ]

Now find the period 4 point we want numerically, in a way that can generalize to higher period k points. 
To find the point with the itinerary (R^(k - 1))L,  look for the periodic point closest to the fixed point at 3/4.  Change k, run the cell, then change the guess and run the cell again

f[x_] := 4 x(1-x);
k = 4;  (* Look for a point with this period *)
Plot[Nest[f,x,k]-x, {x, .7, .8}]
ic = xx/.FindRoot[Nest[f,xx,k]-xx == 0, {xx, .8}]  (* The last number is a guess based on the graph *)

Then run this cell to get the itinerary of that point.

g[x_] := 4 x(1-x);
x0 = ic;
xMin = 0;
xMax =1;
nTransients = 0;
nIterations =2k;
(* Define parameters before running Module *)
runIteratedMap
Print["itinerary = ",itinerary[iterates] ]