1
$\begingroup$

My bifurcation diagram almost works, but I can't figure out how to replace the point number on the horizontal axis with the x coordinate from my calculation. I have tried a whole bunch of things that fail in various ways. The code is below. Help would be greatly appreciated.

bifurcation

z[0, c_] := c;
z[n_, c_] := z[n - 1, c]^2 + c;
zSeries[n_, len_, c_] := Module[{ser},
   ser = {z[n, c]};
   Do[AppendTo[ser, ser[[i]]^2 + c], {i, 1, len - 1}];
   ser];
ListPlot[Transpose[Table[zSeries[999, 100, x], {x, -2, .25, .0001}]], PlotStyle -> PointSize[Tiny]]

If I change the zSeries module to give each point its own x value, it gets VERY slow.

zSeries[n_, len_, c_] := Module[{ser},
   ser = {{c, z[n, c]}};
   Do[AppendTo[ser, {c, ser[[i]]^2 + c}], {i, 1, len - 1}];
   ser];
$\endgroup$
8
  • $\begingroup$ Try the DataRange option in ListPlot. $\endgroup$
    – bbgodfrey
    Commented Feb 18, 2016 at 1:41
  • 1
    $\begingroup$ Jerry, as bb says, you adjust DataRange so that the horizontal axis is in the right units. Look at the docs for it. BTW, NestList[] is pretty useful for implementing your zSeries. $\endgroup$ Commented Feb 18, 2016 at 2:05
  • 1
    $\begingroup$ Since the $x$-coordinate is fixed, you could just do something like {c, #} & /@ ser after generating them like in your original version. $\endgroup$ Commented Feb 18, 2016 at 2:41
  • 1
    $\begingroup$ Do you realize that Do[AppendTo[res, f[x]], {x, n}] is the same as res = Table[f[x], {x, n}], only 100 times slower (ignoring the time to compute f[x])? $\endgroup$
    – Michael E2
    Commented Feb 18, 2016 at 2:48
  • 2
    $\begingroup$ @Jerry, as I said, consider using NestList[]; repeated use of AppendTo[] is well-known to be a slow way of accumulating results. $\endgroup$ Commented Feb 18, 2016 at 2:50

2 Answers 2

3
$\begingroup$

To illustrate my comment, is that what you had in mind?

ListPlot[Transpose[Table[zSeries[999, 100, x], {x, -2, .25, .0001}]], 
    PlotStyle -> PointSize[Tiny], DataRange -> {-2, .25}]

enter image description here

Addendum: Timing

The OP in his answer provides revised code,

z[0, c_] := c;
z[n_, c_] := z[n - 1, c]^2 + c;
ListPlot[Catenate[Table[{x, #} & /@ NestList[#^2 + x &, z[999, x], 100], 
    {x, -2, .25, .0001}]], PlotStyle -> PointSize[Tiny]]

which is much faster than the earlier code, requiring 64 sec (AbsoluteTiming) on my PC to generate the plot. Still, it seemed to me that further improvements in time could be achieved. Table requires 37 sec to generate the array, leaving 27 sec for ListPlot itself. Because as many as 100 duplicate points are plotted for x > -1.4, applying DeleteDuplicates offers an obvious savings. (It, like Catenate, takes negligible time.) Using FixedPointList instead of NestList also saves a bit of time for x > -.76, but only a few seconds, because the reduced list generation is largely offset by the test for a fixed point. Together,

ListPlot[Catenate[Table[{x, #} & /@ DeleteDuplicates[
   FixedPointList[#^2 + x &, z[999, x], 100]], {x, -2, .25, .0001}]], 
   PlotStyle -> PointSize[Tiny], PlotRange -> All]

requires only about 41 sec. The other opportunity for savings involves replacing z[999, x], which takes some 31 sec in all, by the equivalent Nest[#^2 + x &, x, 999],

ListPlot[Catenate[Table[{x, #} & /@ DeleteDuplicates[
    FixedPointList[#^2 + x &, Evaluate[Nest[#^2 + x &, x, 999]], 100]], 
    {x, -2, .25, .0001}]], PlotStyle -> PointSize[Tiny], PlotRange -> All]

which reduces total time to 11 sec, a significant improvement. (Using FixedPoint instead of Nest offers no further advantage.)

$\endgroup$
12
  • $\begingroup$ It gets the job done in this case, because my x's happen to be evenly spaced. It's not really directly using my x coordinate. If my x's weren't evenly spaced, this wouldn't work. Does that make sense? $\endgroup$ Commented Feb 18, 2016 at 2:14
  • $\begingroup$ It's not the spacing being used here @Jerry; the horizontal axis is merely being scaled so that the left and right extents of the plot correspond to what's on your data. $\endgroup$ Commented Feb 18, 2016 at 2:16
  • $\begingroup$ I think I need to associate an x-value with each set of points calculated from that x. $\endgroup$ Commented Feb 18, 2016 at 2:17
  • 1
    $\begingroup$ @JerryGuern I have been able to reduce runtime by a factor of about six, as shown in the addition to my answer. Best wishes. $\endgroup$
    – bbgodfrey
    Commented Feb 18, 2016 at 15:36
  • 1
    $\begingroup$ @JerryGuern I too found this problem instructive. Your definition of z follows standard procedure, but in retrospect was consuming a lot of time. I shall consider that when I define similar functions. Cantenate was new to me, although it is not that different from Flatten. With my changes, the majority of the time now goes to ListPlot itself, so I think that the only way to save much more time is to plot fewer points. Best wishes. $\endgroup$
    – bbgodfrey
    Commented Feb 18, 2016 at 23:11
2
$\begingroup$

From the OP: Based on the helpful Comments and Answer above, here's all I needed to do to get the plot I wanted:

z[0, c_] := c;
z[n_, c_] := z[n - 1, c]^2 + c;
ListPlot[Catenate[Table[{x, #} & /@ NestList[#^2 + x &, z[999, x], 100], {x, -2, .25, .0001}]], PlotStyle -> PointSize[Tiny]]
$\endgroup$
0

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.