0
$\begingroup$

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?

$\endgroup$
  • 1
    $\begingroup$ 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. ) $\endgroup$ – xzczd Feb 29 '16 at 11:37
  • 1
    $\begingroup$ Try adjusting the code here. $\endgroup$ – Chris K Feb 29 '16 at 13:33
3
$\begingroup$

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.

| improve this answer | |
$\endgroup$
3
$\begingroup$

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"}]

enter image description here

| improve this answer | |
$\endgroup$
  • $\begingroup$ This is so nice! Very insightful for what is happening with the trajectory. $\endgroup$ – Ozera Mar 6 '16 at 2:01
2
$\begingroup$

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]

enter image description here

| improve this answer | |
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.