10
$\begingroup$

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]
Improve this question
$\endgroup$
7
  • $\begingroup$ 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. $\endgroup$
    – halirutan
    Commented May 4, 2012 at 11:05
  • 1
    $\begingroup$ Could you please formulate your problem more fully, with coherent mathematical details? $\endgroup$
    – Vitaliy Kaurov
    Commented May 4, 2012 at 11:55
  • $\begingroup$ I think the second line of the code should be d[c_] := ... instead of [c_] := ... $\endgroup$
    – Heike
    Commented May 4, 2012 at 12:12
  • 1
    $\begingroup$ 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 ... $\endgroup$
    – Szabolcs
    Commented May 4, 2012 at 12:53
  • 1
    $\begingroup$ 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... $\endgroup$
    – rm -rf ♦
    Commented May 5, 2012 at 1:15

1 Answer 1

Reset to default
31
$\begingroup$

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

Improve this answer
$\endgroup$
5
  • $\begingroup$ I just wrote almost exactly this for one of the OP's other questions! :) $\endgroup$
    – Mark McClure
    Commented May 4, 2012 at 12:10
  • 2
    $\begingroup$ Damn it, I wish I knew some of these things when I was working through a chaotic dynamics course... $\endgroup$
    – tkott
    Commented May 4, 2012 at 17:20
  • $\begingroup$ @tkott you and me both. $\endgroup$
    – rcollyer
    Commented May 5, 2012 at 2:59
  • 2
    $\begingroup$ Vitaliy, the second one is absolutely gorgeous, +1. $\endgroup$
    – rcollyer
    Commented May 5, 2012 at 3:00
  • $\begingroup$ @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/… $\endgroup$
    – alancalvitti
    Commented Aug 23, 2012 at 18:00

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.