5
$\begingroup$

I need to plot the bifurcation diagram for the function given below.

g[x_, r_] := 6 x^2 + r x^4 + x^6 

Plot[g[x, -4.9], {x, -2, 2}]

enter image description here

Bifurcation

Code for bifurcation is burrowed from Coloring Bifurcation Diagram question:

CClear[NotComplexQ];
NotComplexQ[c_Complex] := False;
NotComplexQ[c_] := True

CartProd[l_] := Outer[List, l[[1]], l[[2]]]

ArreglaLista[l_] := Select[Map[(x /. #) &, Flatten[l]], NotComplexQ]

Points = Flatten[
   Map[CartProd, 
    Table[{{r}, ArreglaLista[NSolve[g2[x, r] == 0, x]]}, {r, -20, 10, 
      0.01}]], 2];
ListPlot[Points]

enter image description here

Colouring

I've also borrowed the code from the answer by @Kuba to the above-mentioned question, however, it does not work for my problem. How to modify it to get the desired result?

unstable = Select[Points, First@# >= 0 && Last@# == 0 &];
stable = 
  SortBy[#, 
     First] & /@ (Append[#, {0, 0}] & /@ (GatherBy[
       Complement[Points, unstable], Sign@Last@# &]));

ListPlot[stable~Join~{unstable}, 
 PlotStyle -> {Directive[Red, Dashing[0.01]], 
   Directive[ Blue, Dashing[0.01]], 
   Directive[ Red, Dashing[0.008]], 
   Directive[ Blue, Dashing[0.1]]}]

enter image description here

I want the stable line for r>0 to be solid blue, the stable lines for r<0 to be in dashed blue line and the unstable lines to be red dashed.

Is there any general method to do it?

Please help me out. Thank you.

Improve this question
$\endgroup$

1 Answer 1

Reset to default
6
$\begingroup$

You can use ContourPlot to make such 1D bifurcation diagrams easily as in this answer, using ConditionalExpression to handle the stability analysis. I assume g[x, r] is some kind of potential, not x'[t], so that an equilibrium is where D[g[x, r], x]==0 and is stable if D[g[x, r], {x, 2}]>0.

g[x_, r_] = 6  x^2 + r  x^4 + x^6;
dg[x_, r_] = D[g[x, r], x];
dg2[x_, r_] = D[g[x, r], {x, 2}];

ContourPlot[{
  ConditionalExpression[dg[x, r], dg2[x, r] > 0 && r > 0] == 0,
  ConditionalExpression[dg[x, r], dg2[x, r] > 0 && r < 0] == 0,
  ConditionalExpression[dg[x, r], dg2[x, r] < 0] == 0
}, {r, -20, 10}, {x, -5, 5},
ContourStyle -> {{Blue}, {Blue, Dashed}, {Red, Dashed}}, MaxRecursion -> 3, FrameLabel -> {"r", "x"}]

enter image description here

This matches your description but I suspect it isn't what you want. Maybe this is more like it?

ContourPlot[{
  ConditionalExpression[dg[x, r], dg2[x, r] > 0 && Abs[x] < 0.1] == 0,
  ConditionalExpression[dg[x, r], dg2[x, r] > 0 && Abs[x] > 0.1] == 0,
  ConditionalExpression[dg[x, r], dg2[x, r] < 0] == 0
}, {r, -20, 10}, {x, -5, 5},
ContourStyle -> {{Blue}, {Blue, Dashed}, {Red, Dashed}}, MaxRecursion -> 3, FrameLabel -> {"r", "x"}]

enter image description here

Improve this answer
$\endgroup$
5
  • $\begingroup$ Thank you @ChrisK $\endgroup$
    – user444
    Commented Feb 20 at 3:35
  • $\begingroup$ Just one question, Why do you have taken && Abs[x] < 0.1] and && Abs[x] >0.1]?? Why 0.1 and how is it different from $r>0$ and $r<0$???? $\endgroup$
    – user444
    Commented Feb 20 at 3:49
  • $\begingroup$ @user444 I was just guessing that you wanted a graph like the second one, not the first - if that's not correct I can remove the second $\endgroup$
    – Chris K
    Commented Feb 20 at 4:09
  • $\begingroup$ It's alright. I was just curious to know how is different is it from what I asked. $\endgroup$
    – user444
    Commented Feb 20 at 4:46
  • 1
    $\begingroup$ The middle line can be defined by Abs[x] < 0.1 whereas r > 0 makes the left half of the middle line dashed and the right half solid. $\endgroup$
    – Chris K
    Commented Feb 20 at 4:48

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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