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$ Commented Feb 20, 2024 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$ Commented Feb 20, 2024 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$ Commented Feb 20, 2024 at 4:09
  • $\begingroup$ It's alright. I was just curious to know how is different is it from what I asked. $\endgroup$ Commented Feb 20, 2024 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$ Commented Feb 20, 2024 at 4:48

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.