# Bifurcation Diagram for 1D Map

Continuing with the same question I have posted earlier I would like to find the equation of the stable fixed point curve using my graph, i.e. from the curve somehow find the equation for $x=f(x)$. I have been trying using Solve but I keep getting errors. I would also like to find the value of $a$ where bifurcation begins, i.e. it becomes unstable. It looks like about $-1.5$.

f[c_][x_] := x^2 + c;

[c_] := Take[NestList[f[c], 0., 1500], -1]
plotdata = Table[Flatten[{i, d[i]}], {i, -2, 0.1, 0.0011}];
ListPlot[plotdata, PlotRange -> All, Frame -> True, Axes -> True]

• Making at least 4 whitespaces at the beginning of a line converts this line to a code-block! Your pice of code is not executable. Commented May 4, 2012 at 11:05
• Could you please formulate your problem more fully, with coherent mathematical details? Commented May 4, 2012 at 11:55
• I think the second line of the code should be d[c_] := ... instead of [c_] := ... Commented May 4, 2012 at 12:12
• Welcome to Mathematica.SE! Here we try to make each question generally useful to any visitor/googler interested in the topic, not only for the original asker. So when asking a question: 1. please make it self contained, with as little reference to earlier discussions as possible 2. you can edit your questions after you have asked them, to clarify points, fix mistakes, format them, etc. 3. if you need clarifications about an answer you received, please comment on the answer instead of asking a new question ... Commented May 4, 2012 at 12:53
• Don't vandalize your posts. What is it that you're trying to do? You can't simply remove all the content from the question...
– rm -rf
Commented May 5, 2012 at 1:15

## 1 Answer

Perhaps you are looking to build a bifurcation diagram. There are a few approaches in Mathematica mentioned in Documentation, which I give below. Also please take a look at apps of similar nature at the Wolfram Demonstration Project. I do not have time to dive into your specific problem, and give classic examples of logistic map which also a quadratic function.

Simplest way

ListPlot[ParallelTable[Thread[{r, Nest[r # (1 - #) &,
Range[0, 1, 0.01], 1000]}], {r, 0, 4, 0.01}], PlotStyle -> PointSize[0]]


Using RecurrenceTable

k = 1000; r = Range[3., 4., 1/(k - 1)];
rhs[x_?VectorQ] := r x (1 - x);
iterates = RecurrenceTable[{x[n + 1]==rhs[x[n]], x[0] ==ConstantArray[1./\[Pi], k]},
x, {n, 10^4, 2 10^4}];
data = Transpose[Ceiling[iterates k]];

count[data_, i_] := Module[{c, j},
{j, c} = Transpose[Tally[data]];
Transpose[{j, ConstantArray[i, Length[j]]}] -> Log[N[c]]];

S = SparseArray[Table[count[data[[i]], i], {i, k}], k];
ArrayPlot[Reverse[S], ColorFunction -> "Rainbow"]


Structuring data for ArrayPlot

line[r_, dy_, np_, n0_, n_] := Module[{pts},
With[{logistics = Function[x, r x (1 - x)]},
pts = Join @@ NestList[logistics, Nest[logistics,RandomReal[{0, 1},np],n0],n - 1]];
Log[1.0 + BinCounts[pts, {0, 1, dy}]]]

With[{w = 400, h = 250, r0 = 2.95, r1 = 4.0},
ArrayPlot[ParallelTable[line[r, 1/(w - 1), w, 500, 50],
{r, r0, r1, (r1 - r0)/(h - 1)}], ImageSize -> {w, h}, PixelConstrained -> True]]


• I just wrote almost exactly this for one of the OP's other questions! :) Commented May 4, 2012 at 12:10
• Damn it, I wish I knew some of these things when I was working through a chaotic dynamics course... Commented May 4, 2012 at 17:20
• @tkott you and me both. Commented May 5, 2012 at 2:59
• Vitaliy, the second one is absolutely gorgeous, +1. Commented May 5, 2012 at 3:00
• @Vitaliy Kaurov - agree with rcollyer, that's textbook worthy. Any chance to generalize this curve following for my fractional graph spectra problem? math.stackexchange.com/questions/179257/… Commented Aug 23, 2012 at 18:00