Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

Sign up
Here's how it works:
  1. Anybody can ask a question
  2. Anybody can answer
  3. The best answers are voted up and rise to the top

I have the following Pitchfork bifurcation:

f[x_, r_] := r x - x^3

I was able to find some nice code on this site to draw up the Logistic Map.

I have the following snippet (maybe there is a better solution) to draw the bifurcation diagram, but was wondering if it can be colored to represent the stable from unstable branches? ( saved the file, then modified it). We have three stable branches and one unstable branch. The unstable branch is [0, +r], see:

enter image description here

Is there a way to show the three branches as a solid blue line and the unstable branch as a dashed red line? Also, can we label the axes as $r$ and $x$, and the branches as stable and unstable?

Here is the code snippet that drew the above bifurcation diagram (is there an easier way).

   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[
   Table[{{r}, ArreglaLista[NSolve[f[x, r] == 0, x]]}, {r, -1, 2, 
   0.05}]], 2]

share|improve this question
up vote 3 down vote accepted

This is not general approach. It applies to this particular data.

First, let's select unstable branch. One look at the plot and you know the condidtions:

unstable = Select[Points, First@# >= 0 && Last@# == 0 &]

The rest are stable so we use Complement. There are 3 branches but they are easy to separate because each one has different Sign of the second coordinate (*that's why GatherBy appears) :).

Then ugly Append with {0,0} just to make them look like one curve. And SortBy so there will be no problem with appendding ( it should be one append, two times prepend).

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

             PlotStyle -> {Blue, Blue, Blue, Red}, BaseStyle -> {20, Thickness@.007}, 
             AxesLabel -> {r, x}, 
     Epilog -> (Text @@@ {{"Stable", Scaled[{0.1, .6}]}, {"Stable", Scaled[{0.9, .8}]},
                     {"Stable", Scaled[{0.9, .2}]}, {"Unstable", Scaled[{0.7, .6}]}})]

enter image description here

share|improve this answer
Sorry, forgot about dashing. Just replace Red with {Dashed, Red}. – Kuba Sep 15 '13 at 14:57
Beautiful, thank you! – Amzoti Sep 15 '13 at 15:15

Your Answer


By posting your answer, you agree to the privacy policy and terms of service.

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