# 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. – halirutan May 4 '12 at 11:05
• Could you please formulate your problem more fully, with coherent mathematical details? – Vitaliy Kaurov May 4 '12 at 11:55
• I think the second line of the code should be d[c_] := ... instead of [c_] := ... – Heike May 4 '12 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 ... – Szabolcs May 4 '12 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 May 5 '12 at 1:15

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] 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 ==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! :) – Mark McClure May 4 '12 at 12:10
• Damn it, I wish I knew some of these things when I was working through a chaotic dynamics course... – tkott May 4 '12 at 17:20
• @tkott you and me both. – rcollyer May 5 '12 at 2:59
• Vitaliy, the second one is absolutely gorgeous, +1. – rcollyer May 5 '12 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/… – alancalvitti Aug 23 '12 at 18:00