10

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]
Chris K
  • 20,207
  • 3
  • 39
  • 74
John Stamos
  • 157
  • 2
  • 8
  • 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 04 '12 at 11:05
  • 1
    Could you please formulate your problem more fully, with coherent mathematical details? – Vitaliy Kaurov May 04 '12 at 11:55
  • I think the second line of the code should be d[c_] := ... instead of [c_] := ... – Heike May 04 '12 at 12:12
  • 1
    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 04 '12 at 12:53
  • ... unless of course the clarification brings up a whole new point which is truly worthy of a new question and you're willing to write up all the details again and make the new question self-contained. 4. Finally, please make sure that the question titles you choose are precise and descriptive. Never use something like "Mathematica question". The title should be an informative summary. (Again, you can edit previous questions and fix titles) – Szabolcs May 04 '12 at 12:54
  • 1
    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 05 '12 at 01:15
  • Actually, the first bifurcation point is at $c=−\frac{3}{4}$. This is where the fixed point $\xi=\frac{1}{2}−\frac{1}{2}\sqrt{1−4c}$ becomes unstable, i.e. where $|f′_c(\xi)|\geq 1$. The value of $c\approx−1.5$ is where the behaviour of $x_n$ becomes chaotic. – Heike May 05 '12 at 12:19

1 Answers1

31

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]]

enter image description here

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"]

enter image description here

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]]

enter image description here

Vitaliy Kaurov
  • 73,078
  • 9
  • 204
  • 355