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

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