6
$\begingroup$

I am brand new to Mathematica so please keep that in mind.

I've run into trouble trying to make a bifurcation diagram. Here is what I have done:

I have a function $f(x)$ that relies on a value $r$ (The range of $r$ lies between the values $2.8<r<4$.

What I have done is that I have found 1200 equally spaced subdivisions of $r$ in this range using the code:

L1 := FindDivisions[{2.8, 4}, 1200] 

Then I created 1000 points for each r value in this range using the following code:

x = Table[0, {1000}]
r = L1
x[[1]] = .01
For[i = 1, i < 30, i++, x[[i + 1]] = r*x[[i]] (1 - x[[i]])]
x

(Is this correct?)

Now what I need to do is take the last 100 points of each list (for a given r value) that were generated above. Then I must take those 100 values and plot them on a graph where r is on the x-axis and all the points corresponding to y are plotted above r.

Basically I need to join each value of r (there are 1200 of them) with its corresponding list of 1000 points. Then I must only take the last 100 points of this list and plot them against the specific r value. I must do this for all the r values.

Im totally lost on how to do this! Can anyone give me a few pointers?

$\endgroup$

closed as unclear what you're asking by Quantum_Oli, MarcoB, user9660, Yves Klett, Öskå Apr 30 '16 at 10:48

Please clarify your specific problem or add additional details to highlight exactly what you need. As it's currently written, it’s hard to tell exactly what you're asking. See the How to Ask page for help clarifying this question. If this question can be reworded to fit the rules in the help center, please edit the question.

  • $\begingroup$ What is your function f? Have you see Part (i.e. [[ ]]), Span, and ListPlot? Have you searched this site for "bifurcation"? Quite a few results pop up that may be helpful. $\endgroup$ – MarcoB Apr 27 '16 at 19:18
  • $\begingroup$ My function is f(x)=rx(1-x). I've searched quite a bit but I cant find how to join a point with only certain values of a given set. $\endgroup$ – The Physics Student Apr 27 '16 at 19:27
13
$\begingroup$

George has already provided a solution, but let's try and build up to it piece by piece so we can understand what we are doing. Coming from the worlds of loops, Mathematica's programming style can be confusing.

First of all, we need a way of representing the function to be recursively applied. A pure function would be great for this. For instance:

r # (1 - #) &

We will then use NestList to apply this recursively a set number of times, in your case 1000 times, to the $0.01$ starting value:

NestList[r # (1 - #) &, 0.01, 1000]

This would generate a list of 1001 elements (including the starting point); we only want the last 100 elements of this list, so we use Part (i.e. [[...]]) and Span (i.e. ;;) to select those:

NestList[r # (1 - #) &, 0.01, 1000 - 1][[-100 ;;]]

We would like to keep track of the value of $r$ that generated each of those 100x values of the recursion, so we transform each element in the list into a sublist of the form {r, generatedvalue}, by mapping another simple pure function {r, #} & on the list obtained from NestList (see Map and its shorthand /@):

{r, #} & /@ NestList[r # (1 - #) &, 0.01, 1000][[-100 ;;]]

We now need to apply this recursion to each value of $r$ in your interval of interest. We can use Subdivide to generate such a list:

Subdivide[2.8, 4, 1200]

This will generate a list of $1201$ values, i.e. $1200$ equally spaced subdivisions as requested. We will use Table to run the recursion multiple times, each time with a different value of $r$ from that list above, and save the result in a variable called nestedlist:

nestedlist =
  Table[
    {r, #} & /@ NestList[r # (1 - #) &, 0.01, 1000][[-100 ;;]],
    {r, Subdivide[2.8, 4, 1200]}
  ];

Dimensions[nestedlist]
(*  Out: {1201, 100, 2} *)

The output of Dimensions shows us that our nestedlist contains 1201 lists, one per value of $r$, each of which contains 100 pairs of values, i.e. the {r, generatedvalue} pairs we wanted. This is too "nested"; we really only want a long list of such pairs, so we can "flatten out" the top level of this nested list, to obtain a list of $1201\times100=120100$ pairs. We use Flatten (together with a level specification, 1) for that, and we save the result in flatlist:

flatlist = Flatten[nestedlist, 1];
(* Out: {120100, 2} *)

Now we are ready to plot these points using ListPlot:

ListPlot[flatlist]

bifurcation

$\endgroup$
  • $\begingroup$ Wow! Thanks MarcoB! This really helps me out! Thanks for writing this up! $\endgroup$ – The Physics Student Apr 27 '16 at 20:39
  • $\begingroup$ @ThePhysicsStudent You are very welcome $\endgroup$ – MarcoB Apr 27 '16 at 20:43
9
$\begingroup$
f[r_] := NestList[ r # (1 - #) &, .01, 1000][[-100 ;;]]
ListPlot[Flatten[Table[ {r, #} & /@ f[r] , {r, 2.8, 4, 1/1000}], 1]]

enter image description here

if you want to fix your loop approach it should look something like this:

L1 = Subdivide[2.8, 4, 1200];
ListPlot[
 Flatten[Table[
   x = Table[0, {1000}];
   x[[1]] = .01;
   Do[x[[i + 1]] = r*x[[i]] (1 - x[[i]]), {i, 999}];
   {r, #} & /@ x[[-100 ;;]], {r, L1}], 1] ]]
$\endgroup$
  • $\begingroup$ Ahh! This is great! Thanks George - $\endgroup$ – The Physics Student Apr 27 '16 at 20:19

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