Trouble creating a bifurcation diagram of a trajectory

Question

I wish to create a bifurcation diagram of the trajectory made by $f(x,a) = a - x^2$ which shows the tangent bifurcation point and the period doubling point.

The tangent bifurcation point occurs at $\{a \to -\frac{1}{4}, x \to -\frac{1}{2}\}$ and the period doubling point at $\frac{1}{2}(1 \pm \sqrt[]{-3+4a})$. I've already found the stability for equilibrium points for $f$ and period-2 equilibrium points. Now I wish to make a bifurcation plot to see all of this information together, but I do not know how to do this.

I was trying to figure it out and came up with the following code, but it doesn't really match what I am wanting since it is just a trajectory plot.

traj[x_,a_] = NestList[f, x, 200];

Manipulate[ListPlot[traj[x,a], PlotRange -> All, {{x, -0.5}, -1, 1}, 
{{a, -0.25}, -0.26, 2}  ] ]

Can anyone show me how to create an actual bifurcation diagram for my function?

Your code is incomplete, how did you define f? And the right bracket of ListPlot is lost and there's a redundant right bracket at the end of the code. (Update: just read your previous question, you should have read the answer and comments more carefully, if you have difficulty in understanding them, simply go on asking in the comment. ) — xzczd, Feb 29 '16 at 11:37

score 4 · Answer 1 · answered Mar 01 '16 at 01:00

Just for something else:

f[x_, a_] := a - x^2;
cw[x_, a_, n_] := Module[{i = 0, nl, ln, tr},
  nl = NestWhileList[(i++; {#[[2]], f[#[[2]], a]}) &, {x, f[x, a]}, 
    And[i != n, Abs[#[[2]]] < 100] &];
  ln = Line[{#1, {#1[[2]], #1[[2]]}, #2}] & @@@ 
    Partition[nl, 2, 1]; {ln, nl[[All, 2]]}]
Manipulate[
 Module[{res = cw[x0, a, 100]}, 
  Row[{Show[Plot[{f[x, a], x}, {x, -1, 1}], 
     Graphics[res[[1, 1 ;; Min[20, Length@res[[1]]]]]], 
     PlotRange -> {{-2, 2}, {-2, 2}}, ImageSize -> 300], 
    ListPlot[res[[2]], Joined -> True, ImageSize -> 300, 
     PlotRange -> {-1, 1}]}]], {{a, 0.01}, -0.27, 1, 
  Appearance -> "Labeled"}, {{x0, 0.1}, -1, 1, 
  Appearance -> "Labeled"}]

This is so nice! Very insightful for what is happening with the trajectory. — Ozera, Mar 06 '16 at 02:01

murray · Accepted Answer · 2016-02-29T16:12:32.260

As noted, you didn't show a Mathematica definition of f. Moreover, the definitions of traj is incorrect, and the syntax of Manipulate is wrong. Here's a corrected, complete version:

 f[x_, a_] := a - x^2
 traj[x_, a_] = NestList[f[#, a] &, x, 200];
 Manipulate[
    ListPlot[traj[x, a], PlotRange -> All],
    {{x, -0.5}, -1, 1}, {{a, -0.25}, -0.26, 2}
 ]

Since NestList is to act only upon the second argument x to f, then you need to fix the first argument a there, which is the reason for the change to the first argument of NestList so as to be f[#, a]& rather than just f (which has two arguments).

In your Manipulate, you misplaced the right bracket ] that matches the left bracket [ of ListPlot. The control variable expressions for the Manipulate need to go outside the ListPlot expression, not inside it.

To display the current values of the controls a and x, you might want to include the `Appearance -> "Labeled" option for each of the them:

 f[x_, a_] := a - x^2
 traj[x_, a_] = NestList[f[#, a] &, x, 200];
 Manipulate[
    ListPlot[traj[x, a], PlotRange -> All],
    {{x, -0.5}, -1, 1, Appearance -> "Labeled"}, 
    {{a, -0.25}, -0.26, 2, Appearance -> "Labeled"}
 ]

You probably also want to alter the initial value and lower bound of a, because you'll too easily get computational overflow at that initial value, and nearby values, if you decrease the value of x below its initial value. Or at least trap the troublesome values.

score 3 · Answer 3 · answered Nov 15 '16 at 03:16

A common way to plot bifurcation diagrams is with the parameter on the horizontal axis and the values of the stable periodic orbits on the vertical. For the function f[k] = a-f[k-1]^2, this can be done as

Clear[f, a];
f[a_, n_] := f[a, n] = a - f[a, n - 1]^2;
f[a_, 1] = 0.5;
all = Flatten[Table[seq = f[aa, #] & /@ Range[10000];
    seq1000 = Union[seq[[9900 ;; 10000]]];
    Thread[{ConstantArray[aa, Length[seq1000]], seq1000}], 
           {aa, -0.2, 2, 0.01}], 1];
ListPlot[all, PlotRange -> All]

Trouble creating a bifurcation diagram of a trajectory

3 Answers3