4
$\begingroup$

I have a question about plotting in Mathematica in general, and this particular recurrence relation as an example:

$\qquad x _{n+1} = rx_{n}(1-x_{n})$

How can I plot the following plots as shown below?

Here's where I am at so far, after searching the web for the code:

sol = RSolve[{x[n + 1] == 2.8*x[n]*(1 - x[n]), x[0] == 0.2}, x[n], n]
ListPlot[Table[{n, x[n] /. sol[[1]]}, {n, 1, 5}], 
  PlotStyle -> {Hue[1], PointSize[0.0125]}];

But this doesn't give me anything. Or should I use some alternative with NestList?

I have also tried the version below (another answer here on SE), but this simply doens't work (no output whatsoever, and this is a Web Diagram - not a simple logistic map that I am looking for):

logistic[α_, x0_] := 
  Module[{f}, 
    f[x_] := α x (1 - x);
    seq = NestList[f, x0, 100];
    p = Join @@ ({{#, #}, {##}} & @@@ Partition[seq, 2, 1]);
    Plot[{f[x], x}, {x, 0, 1}, 
      PlotRange -> {0, 1},
      Epilog -> {Thick, Opacity[0.6], Line[p]}, 
      ImageSize -> 500]];

The plots that I want to achieve:

Example from Wolfram MathWorld

Source: http://mathworld.wolfram.com/LogisticMap.html

$\endgroup$
6
  • $\begingroup$ The reason the lostic function doesn't do anything is because it's a function and you have to call it. For example: logistic[3.5, 0.1] $\endgroup$
    – bill s
    Apr 29 '16 at 12:30
  • $\begingroup$ First off, in your code you have a semicolon after the Plot command, so you won't get a plot. Second, have a look at the output of RSolve - it does not give an analytic solution. If you look at the mathworld page it says there is an analytic solution only for r equal to -2, 2, or 4, though the only attribution is to a private communication from Michael Trott. $\endgroup$
    – Jason B.
    Apr 29 '16 at 13:33
  • $\begingroup$ So if you are working with other r values, then you need to generate the list numerically using RecurrenceTable $\endgroup$
    – Jason B.
    Apr 29 '16 at 13:34
  • $\begingroup$ @JasonB What is shown on the plots are not solutions, they are several iterates of the logistic function $f$, that is, graphs of $f, f^2, f^3,\ldots$ $\endgroup$
    – Artem
    Apr 29 '16 at 13:45
  • 1
    $\begingroup$ @Pavoo - for future reference you can usually download a Mathematica notebook from the relevant MathWorld page that will allow you to generate any of the plots there - although they were most all made in version 6 or before, so there is definite room to update the code. $\endgroup$
    – Jason B.
    Apr 29 '16 at 14:09
6
$\begingroup$

First off, in your code

sol = RSolve[{x[n + 1] == 2.8*x[n]*(1 - x[n]), x[0] == 0.2}, x[n], n] ListPlot[Table[{n, x[n] /. sol[[1]]}, {n, 1, 5}], PlotStyle -> {Hue[1], PointSize[0.0125]}];

you have a semicolon after the ListPlot command, so you won't get a plot. Second, have a look at the output of RSolve - it does not give an analytic formula.

sol = 
 RSolve[{x[n + 1] == 2.8*x[n]*(1 - x[n]), x[0] == 0.2}, x[n], n]
(* RSolve[{x[1 + n] == 2.8 (1 - x[n]) x[n], x[0] == 0.2}, x[n],
  n] *)

If you look at the MathWorld page it says there is an analytic solution only for r equal to -2, 2, or 4, though the only attribution is to a private communication from Michael Trott (is there no other attribution available? Trott doesn't have an account on here....)

sol = RSolve[{x[n + 1] == #*x[n]*(1 - x[n]), x[0] == x0}, x[n], 
    n] & /@ {-2, 2, 4} 

{{{x[n] -> 1/2 (1 + 2 Cos[2^n ArcCos[1/2 (-1 + 2 x0)]])}}, {{x[n] -> 
    1/2 (1 - (1 - 2 x0)^2^n)}}, {{x[n] -> 
    1/2 (1 - Cos[2^n ArcCos[1 - 2 x0]])}}}

But you can just generate what you want with RecurrenceTable,

sol = 
 RecurrenceTable[{x[n + 1] == 2.8*x[n]*(1 - x[n]), x[0] == 0.2}, 
  x, {n, 1, 5}]
(* {0.448, 0.692429, 0.596319, 0.674023, 0.615205} *)

And you can feed that list to listplot. The second bit of code you have works fine, as shown by dionys in his answer.

For the plots you have at the end of your question, again use RecurrenceTable. You don't even need to supply numeric values for RecurrenceTable. The plots you look for can be easily found with

funcs = RecurrenceTable[{x[n + 1] == r x[n] (1 - x[n]), x[0] == x0}, 
   x, {n, 1, 5}];
Plot[funcs /. r -> 3, {x0, 0, 1}, Evaluated -> True, PlotRange -> All]

Mathematica graphics

You can also vary the value of r to see the effect with Manipulate

Manipulate[
 Plot[funcs /. r -> rr, {x0, 0, 1}, Evaluated -> True, 
  PlotRange -> All, ImageSize -> 500, PlotLabel -> Row[{"r = ", rr}], 
  LabelStyle -> 18]
 , {rr, -2, 4, .01}]

enter image description here

$\endgroup$
0
0
$\begingroup$

The code you posted works, but it generates a cobweb plot:

logistic[2.8, 0.1]

enter image description here

For the visualization you want, take a closer look at the definitions of f and seq in the code you posted. The plots you want to generate shows x[n] vs. start value, x0, for iterations 1 through 5, at 4 different growth rates, r.

recurrenceList[r_, x0_, n_:50] := NestList[(r # (1 - #)) &, x0, n - 1]

Module[{fns, colors},
    colors = {Red, Yellow, Green, Blue, Lighter[Purple, 0.6]};
    GraphicsGrid@Partition[Table[
        fns = Table[recurrenceList[r, x][[n + 1]], {n, 1, 5}];
        Plot[fns, {x, 0, 1}, PlotStyle -> colors], {r, 1, 4}], 2]]

enter image description here

$\endgroup$
0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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