Coloring Bifurcation Diagram

Question

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:

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).

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

 ListPlot[Points]

Answer 1

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@# &]
                                    )
                               ) 


ListLinePlot[stable~Join~{unstable}, 
             PlotStyle -> {Blue, Blue, Blue, Red}, BaseStyle -> {20, [email protected]}, 
             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}]}})]