# Problem generating a cobweb diagram/ visual iteration of a cubic map

With reference to "Non-linear Physics with Mathematica for Scientist and Engineers", I extrapolate the codes for a visualisation of an iterative cubic map but ran into problems.

f[x_] := (a - 1) x + a x^3;

a = 3.3; b = 0.2; total = 60;

g = Nest[f, x, 2];

pts = Flatten[NestList[f, {b, b, b, b}, total]];

pts2 = Partition[Drop[pts, 3], 2];

Block[{\$DisplayFunction = Identity},
gr[0] = ListPlot[{{b, 0}, {b, f[b]}}, Joined -> True,
PlotStyle -> {Hue[0.6]}];
gr[1] = ListPlot[pts2, Joined -> True, PlotStyle -> {Hue[0.6]}];
gr[2] = Plot[x, {x, 0, 1}, PlotStyle -> {Hue[1]}];
gr[3] = Plot[f[x], {x, 0, 1}, PlotStyle -> {Hue[0.3]}];
gr[4] = Plot[g, {x, 0, 1}, PlotStyle -> {Dashing[{0.2}]}]]

Show[Table[gr[i], {i, 0, 4}], AxesLabel -> {"X", " "},
PlotRange -> {{0, 1}, {0, 1}},
AspectRatio -> 1,
Epilog -> {Text["g", {0.2, 0.85}, {0, -1}],
Text["f", {0.4, 0.8}, {0, -1}], Text["y=x", {0.86, 0.9}, {0, -1}],
Text["\!$$\*SubscriptBox[\(X$$, $$0$$]\)", {b + .3,
0.1}, {0, -1}],
TextStyle -> {FontFamily -> "Times", FontSize -> 16},
ImageSize -> {500, 500}}]


The visual iteration is not performing as intended. I would like a forward iteration given any parameter a and initial point x0 such that the convergence (or divergence of fixed point) can be observed. The current visual iteration produces a 'broken' snap shot of all trajectories.

Any help is appreciated. Thanks in advance.

## 1 Answer

Your parameters result in overflow, so you need to fix it, but otherwise you can do something like that:

fp[x_, a_] := Nest[(a - 1) # + a #^3 &, x, 1]
gp[x_, a_] := Nest[fp[#, a] &, x, 2]

iterate[x0_, a_, n_] := Module[{trace},
trace = Sequence @@ {##, {#[[2]], #[[2]]}} & /@
NestList[{#[[2]], fp[#[[2]], a]} &, {x0, fp[x0, a]}, n - 1];
Prepend[#, {x0, 0}] &@trace
]

Manipulate[
Show[
Plot[{x, fp[x, a], gp[x, a]}, {x, 0, 1},
AspectRatio -> 1,
PlotRange -> {{0, 1}, {0, 1}},
PlotStyle -> {Hue[1], Hue[0.3], Dashing[{0.2}]}
],
ListLinePlot[iterate[b, a, total], PlotRange -> {{0, 1}, {0, 1}}],
Epilog -> {
Text["y=x", {0.86, 0.9}, {0, -1}],
TextStyle -> {FontFamily -> "Times", FontSize -> 16},
},
ImageSize -> {500, 500}
],
{{a, 1.5}, 1, 2, 0.01}, {{total, 10}, 1, 20, 1}, {{b, 0.2}, 0, 1}
]