# Mathematica Bifurcation

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
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[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! :) –  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