Iterates[f_, n_, x0_] := Module[{list}, list = Table[x0, {i, 1, n}]; Do[list[[i]] = f[list[[i - 1]]], {i, 2, n}]; list]; CobwebLine[values_, k_] := Module[{points}, points = Flatten[Table[{{values[[i]], values[[i]]}, {values[[i]], values[[i + 1]]}}, {i, 1, k - 1}], 1]; {RGBColor[0, 0.2, 0.5], {Line[points], Map[Disk[#, 0.007] &, points]}}]; CobwebDiagram[f_, n_, x0_] := Show[Plot[{f[x], x}, {x, 0, 1}, PlotRange -> {0, 1}, AspectRatio -> 1, PlotStyle -> Black], Graphics[CobwebLine[Iterates[f, n, x0], n]]]; Manipulate[ CobwebDiagram[Mod[2 #, 1] &, n, x], {x, 0, 1}, {n, 2, 100, 1}] Manipulate[CobwebDiagram[Cos, n, x], {x, 0, 1}, {n, 2, 100, 1}] Manipulate[ CobwebDiagram[r # (1 - #) &, n, x], {x, 0, 1}, {n, 1, 100, 1}, {r, 2, 4}] f[r_, x_] := r x (1 - x); q1[r_] := If[r < 3, 0, (r + 1 + Sqrt[(r - 3) (r + 1)])/(2 r)]; q2[r_] := If[r < 3, 0, (r + 1 - Sqrt[(r - 3) (r + 1)])/(2 r)]; Manipulate[ Show[Plot[{x, f[r, x], f[r, f[r, x]]}, {x, 0, 1}, PlotRange -> {0, 1}, AspectRatio -> 1, PlotStyle -> {Gray, Black, Blue}], Graphics[{Disk[{1 - 1/r, 1 - 1/r}, 0.008], Disk[{0, 0}, 0.008], Disk[{q1[r], q1[r]}, 0.008], Disk[{q2[r], q2[r]}, 0.008]}]], {r, 0.01, 4}]