For a Study of the Logistic Map 

 

We will first use the un-renormalized equation, which says that  

         n[t+1] = r*n[t]*(1-n[t]/N) , where N is the total carrying capacity of the system. 

 We then choose parameters as in the text. 

> `:=`(n[0], 4); 1; `:=`(r, 2); 1; `:=`(N, 1000.0); 1
 

 

 

4
2
1000.0 (1)
 

> `:=`(n[1], `*`(r, `*`(n[0], `*`(`+`(1, `-`(`/`(`*`(n[0]), `*`(N)))))))); 1
 

7.968000000 (2)
 

> `:=`(n[2], `*`(r, `*`(n[1], `*`(`+`(1, `-`(`/`(`*`(n[1]), `*`(N)))))))); 1
 

15.80902195 (3)
 

> `:=`(n[3], `*`(r, `*`(n[2], `*`(`+`(1, `-`(`/`(`*`(n[2]), `*`(N)))))))); 1
 

31.11819355 (4)
 

> `:=`(n[4], `*`(r, `*`(n[3], `*`(`+`(1, `-`(`/`(`*`(n[3]), `*`(N)))))))); 1
 

60.29970316 (5)
 

At this point we get tired, and do a lot of them at once. 

> for au to 15 do `:=`(n[au], `*`(r, `*`(n[`+`(au, `-`(1))], `*`(`+`(1, `-`(`/`(`*`(n[`+`(au, `-`(1))]), `*`(N)))))))) end do; 1
 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

7.968000000
15.80902195
31.11819355
60.29970316
113.3272979
200.9684429
321.1602557
436.0326917
491.8163669
499.8660563
499.9999641
500.0000000
500.0000000
500.0000000
500.0000000 (6)
 

Then we should plot the results, but it's not very complicated, so we don't bother for now. 

Below is the value that it would have had if we simply use the exponential map: 

> `+`(`*`(4, `*`(`^`(2, 11)))); 1
 

8192 (7)
 

Now let's try a much larger value of r 

> `:=`(r, 3.3); 1
 

3.3 (8)
 

> `:=`(x[0], `/`(1, 4)); 1
 

`/`(1, 4) (9)
 

Having seen how it works, now let's introduce x = n/N, which then can only vary from 0 to 1: 

 the equation is    x[t+1] = r*x[t]*(1-x[t]). 

 

> for am from 0 to 21 do `:=`(x[`+`(am, 1)], `*`(r, `*`(x[am], `*`(`+`(1, `-`(x[am])))))) end do; 1
 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

.6187500000
.7784648438
.5691091916
.8092389347
.5094252283
.8247068445
.4770660350
.8232643100
.4801506134
.8236998060
.4792208375
.8235751473
.4794871093
.8236114305
.4794096188
.8236009194
.4794320684
.8236039688
.4794255555
.8236030843
.4794274446
.8236033408 (10)
 

> with(plots); 1
 

[animate, animate3d, animatecurve, arrow, changecoords, complexplot, complexplot3d, conformal, conformal3d, contourplot, contourplot3d, coordplot, coordplot3d, densityplot, display, fieldplot, fieldpl...
[animate, animate3d, animatecurve, arrow, changecoords, complexplot, complexplot3d, conformal, conformal3d, contourplot, contourplot3d, coordplot, coordplot3d, densityplot, display, fieldplot, fieldpl...
[animate, animate3d, animatecurve, arrow, changecoords, complexplot, complexplot3d, conformal, conformal3d, contourplot, contourplot3d, coordplot, coordplot3d, densityplot, display, fieldplot, fieldpl...
[animate, animate3d, animatecurve, arrow, changecoords, complexplot, complexplot3d, conformal, conformal3d, contourplot, contourplot3d, coordplot, coordplot3d, densityplot, display, fieldplot, fieldpl...
[animate, animate3d, animatecurve, arrow, changecoords, complexplot, complexplot3d, conformal, conformal3d, contourplot, contourplot3d, coordplot, coordplot3d, densityplot, display, fieldplot, fieldpl...
[animate, animate3d, animatecurve, arrow, changecoords, complexplot, complexplot3d, conformal, conformal3d, contourplot, contourplot3d, coordplot, coordplot3d, densityplot, display, fieldplot, fieldpl...
[animate, animate3d, animatecurve, arrow, changecoords, complexplot, complexplot3d, conformal, conformal3d, contourplot, contourplot3d, coordplot, coordplot3d, densityplot, display, fieldplot, fieldpl...
(11)
 

> `:=`(r33plot, pointplot([seq([n, x[n]], n = 1 .. 16)])); 1
 

PLOT(POINTS([1., .6187500000], [2., .7784648438], [3., .5691091916], [4., .8092389347], [5., .5094252283], [6., .8247068445], [7., .4770660350], [8., .8232643100], [9., .4801506134], [10., .8236998060... (12)
 

> display(r33plot, view = [0 .. 18, 0 .. 1]); 1
 

Plot_2d
 

We see that this is indeed a period-two situation, as one thought as well from the numbers. 

Let's make r back to its arbitrary value, and look at our underlying functions for a moment. 

>
 

> `:=`(r, 'r'); 1
 

r (13)
 

> `:=`(f, proc (x) options operator, arrow; `*`(r, `*`(x, `*`(`+`(1, `-`(x))))) end proc); 1
 

proc (x) options operator, arrow; `*`(r, `*`(x, `*`(`+`(1, `-`(x))))) end proc (14)
 

To find the fixed points we look for the intersections of x and f(x): 

> `:=`(fx1, map(factor, solve(x = f(x), [x]))); 1
 

[[x = 0], [x = `/`(`*`(`+`(`-`(1), r)), `*`(r))]] (15)
 

To determine their stability we evaluate the derivative of f(x) at those points: 

> `:=`(stab1, simplify([seq(subs(fx1[n], diff(f(x), x)), n = 1 .. 2)])); 1
 

[r, `+`(2, `-`(r))] (16)
 

As the derivative must have absolute value less than or equal to 1, for stability, we see that  

the first fixed point is stable up to r=1, when the second one then takes over, and remains stable until r=3. 

> plot([x, subs(r = 1.5, f(x))], x = 0 .. 1)
 

Plot_2d
 

Now, let's think about double period situations, such as the one with r=3.3 above. 

We begin by looking at the first iterate---often called second iterate---of our map 

> `:=`(g, proc (x) options operator, arrow; f(f(x)) end proc); 1
 

proc (x) options operator, arrow; f(f(x)) end proc (17)
 

> g(x); 1
 

`*`(`^`(r, 2), `*`(x, `*`(`+`(1, `-`(x)), `*`(`+`(1, `-`(`*`(r, `*`(x, `*`(`+`(1, `-`(x))))))))))) (18)
 

> factor(g(x)); 1
 

`+`(`-`(`*`(`^`(r, 2), `*`(x, `*`(`+`(`-`(1), x), `*`(`+`(1, `-`(`*`(r, `*`(x))), `*`(r, `*`(`^`(x, 2)))))))))) (19)
 

We will ask when it intersects x 

> `:=`(fp2, map(factor, solve(x = g(x), [x]))); 1
 

[[x = 0], [x = `/`(`*`(`+`(`-`(1), r)), `*`(r))], [x = `+`(`/`(`*`(`/`(1, 2), `*`(`+`(r, 1, `*`(`^`(`*`(`+`(r, 1), `*`(`+`(r, `-`(3)))), `/`(1, 2)))))), `*`(r)))], [x = `+`(`/`(`*`(`/`(1, 2), `*`(`+`(... (20)
 

As should have been expected, the fixed points are of course also fixed points for the iterate;  

However, there are also two new ones, but only when r is greater than or equal to 3. 

> `:=`(stab2, map(factor, simplify([seq(subs(fp2[n], diff(g(x), x)), n = 1 .. 4)]))); 1
 

[`*`(`^`(r, 2)), `*`(`^`(`+`(`-`(2), r), 2)), `+`(`*`(2, `*`(r)), `-`(`*`(`^`(r, 2))), 4), `+`(`*`(2, `*`(r)), `-`(`*`(`^`(r, 2))), 4)] (21)
 

It is the last two that are of interest---noting that both of them give the same value to the derivative, and remembering that we only care when r is in [3,4] 

> factor(solve(stab2[3] = 1, [r])), factor(solve(stab2[3] = -1, [r])); 1
 

[[r = -1], [r = 3]], [[r = `+`(1, `-`(`*`(`^`(6, `/`(1, 2)))))], [r = `+`(1, `*`(`^`(6, `/`(1, 2))))]] (22)
 

> evalf(`+`(1, sqrt(6))); 1
 

3.449489743 (23)
 

Of course only r=3 and r=1+sqrt(6) are relevant.  These tell us that these two double points are stable fixed points, for g, when r is between 3 and 1+\sqrt{6) =  

3.4495 

The plot just below is for exactly 3, where all these points are the same, while the one below that isfor r=3.4, with the two double points 

> plot(subs(r = 3, [x, f(x), g(x)]), x = 0 .. 1, 0 .. .81); 1
 

Plot_2d
 

> plot(subs(r = 3.4, [x, f(x), g(x)]), x = 0 .. 1, 0 .. .91); 1
 

Plot_2d
 

A different approach is to plot the actual map: 

> `:=`(r, 3.4); 1; `:=`(x[0], .1); 1
 

 

3.4
.1 (24)
 

> for b to 100 do `:=`(x[b], `*`(r, `*`(x[`+`(b, `-`(1))], `*`(`+`(1, `-`(x[`+`(b, `-`(1))])))))) end do; -1
 

> pointplot([seq([n, x[n]], n = 0 .. 100)]); 1
 

Plot_2d
 

As to what happens beyond that, let's see.  We begin by looking at the third iterate. 

But we also have to put r back to its arbitrary value. 

> `:=`(r, 'r'); 1
 

r (25)
 

> `:=`(pt3, proc (x) options operator, arrow; f(g(x)) end proc); 1
 

proc (x) options operator, arrow; f(g(x)) end proc (26)
 

> factor(pt3(x)); 1
 

`+`(`-`(`*`(`^`(r, 3), `*`(x, `*`(`+`(x, `-`(1)), `*`(`+`(1, `-`(`*`(r, `*`(x))), `*`(r, `*`(`^`(x, 2)))), `*`(`+`(1, `-`(`*`(`^`(r, 2), `*`(x))), `*`(`^`(r, 3), `*`(`^`(x, 2))), `-`(`*`(2, `*`(`^`(r,... (27)
 

For intersections, we ask the same question as earlier: 

> solve(x = pt3(x), [x]); 1
 

[[x = 0], [x = `/`(`*`(`+`(`-`(1), r)), `*`(r))], [x = `/`(`*`(RootOf(`+`(`*`(`^`(r, 2)), r, 1, `*`(`+`(`-`(`*`(2, `*`(r))), `-`(`*`(2, `*`(`^`(r, 2)))), `-`(1), `-`(`*`(`^`(r, 3)))), `*`(_Z)), `*`(`+...
[[x = 0], [x = `/`(`*`(`+`(`-`(1), r)), `*`(r))], [x = `/`(`*`(RootOf(`+`(`*`(`^`(r, 2)), r, 1, `*`(`+`(`-`(`*`(2, `*`(r))), `-`(`*`(2, `*`(`^`(r, 2)))), `-`(1), `-`(`*`(`^`(r, 3)))), `*`(_Z)), `*`(`+...
(28)
 

This says we need the solution of a sextic polynomial.  Let's PUNT, instead. 

> plot(subs(r = 3.5, [x, f(x), g(x), pt3(x)]), x = 0 .. 1, 0 .. .91); 1
 

Plot_2d
 

The blue curve is our third iterate; however, for 3.5 we see that there are no other intersections than the expected two. 

We should,I suppose, try r=3.53 

 

> plot(subs(r = 3.53, [x, f(x), g(x), pt3(x)]), x = 0 .. 1, 0 .. .91); 1
 

Plot_2d
 

> plot(subs(r = 3.6, [x, f(x), g(x), pt3(x)]), x = 0 .. 1, 0 .. .91); 1
 

Plot_2d
 

Doesn't seem like it's going to work.  Perhaps we need to do the next most logical thing, the second iterate of g,  

perhaps appropriate for bifurcations. 

>
 

> `:=`(pt4, proc (x) options operator, arrow; g(g(x)) end proc); 1
 

proc (x) options operator, arrow; g(g(x)) end proc (29)
 

> factor(pt4(x)); 1
 

`+`(`-`(`*`(`^`(r, 4), `*`(x, `*`(`+`(x, `-`(1)), `*`(`+`(1, `-`(`*`(r, `*`(x))), `*`(r, `*`(`^`(x, 2)))), `*`(`+`(1, `-`(`*`(`^`(r, 2), `*`(x))), `*`(`^`(r, 3), `*`(`^`(x, 2))), `-`(`*`(2, `*`(`^`(r,...
`+`(`-`(`*`(`^`(r, 4), `*`(x, `*`(`+`(x, `-`(1)), `*`(`+`(1, `-`(`*`(r, `*`(x))), `*`(r, `*`(`^`(x, 2)))), `*`(`+`(1, `-`(`*`(`^`(r, 2), `*`(x))), `*`(`^`(r, 3), `*`(`^`(x, 2))), `-`(`*`(2, `*`(`^`(r,...
`+`(`-`(`*`(`^`(r, 4), `*`(x, `*`(`+`(x, `-`(1)), `*`(`+`(1, `-`(`*`(r, `*`(x))), `*`(r, `*`(`^`(x, 2)))), `*`(`+`(1, `-`(`*`(`^`(r, 2), `*`(x))), `*`(`^`(r, 3), `*`(`^`(x, 2))), `-`(`*`(2, `*`(`^`(r,...
(30)
 

>
 

>
 

> plot(subs(r = 3.6, [x, f(x), g(x), pt3(x), pt4(x)]), x = 0 .. 1, 0 .. 1); 1
 

Plot_2d
 

In fact, yes, now we see some extra intersections with this one, the violet one. 

Even back, earlier, those exist, so that's the period 4 ones, with period 3 skipped. 

> plot(subs(r = 3.5, [x, f(x), g(x), pt3(x), pt4(x)]), x = 0 .. 1, 0 .. .91); 1
 

Plot_2d
 

>
 

> plot(subs(r = 3.2, [x, f(x), g(x), pt3(x)]), x = 0 .. 1, 0 .. .9); 1
 

Plot_2d
 

> `:=`(r, 3.5); 1; `:=`(xq[0], .1); 1
 

 

3.5
.1 (31)
 

> for av to 100 do `:=`(xq[av], `*`(r, `*`(xq[`+`(av, `-`(1))], `*`(`+`(1, `-`(xq[`+`(av, `-`(1))])))))) end do; -1
 

> xq[97]; 1
 

.5008842082 (32)
 

> pointplot([seq([n, xq[n]], n = 1 .. 100)]); 1
 

Plot_2d
 

Yes, we have 4 periods now. 

So, now, I'm skipping forward, and wondering how to get period 8, or even chaos. 

> `:=`(r, 3.55); 1; `:=`(x[0], .1); 1
 

 

3.55
.1 (33)
 

> for bb to 100 do `:=`(x[bb], `*`(r, `*`(x[`+`(bb, `-`(1))], `*`(`+`(1, `-`(x[`+`(bb, `-`(1))])))))) end do; -1
 

> pointplot([seq([n, x[n]], n = 1 .. 100)]); 1
 

Plot_2d
 

Well, I'm unsure how many periods that is. 

> plot([x, f(x), g(x), pt3(x), pt4(x)], x = 0 .. 1, 0 .. .91); 1
 

Plot_2d
 

Let's go ahead and try 3.6 

> `:=`(r, 3.6); 1; `:=`(x[0], .2); 1
 

 

3.6
.2 (34)
 

> for cc to 300 do `:=`(x[cc], `*`(r, `*`(x[`+`(cc, `-`(1))], `*`(`+`(1, `-`(x[`+`(cc, `-`(1))])))))) end do; -1
 

> pointplot([seq([n, x[n]], n = 1 .. 300)]); 1
 

Plot_2d
 

As expected I see no discernable periodicity, or pattern, here, although, yes, there are parts of the diagram that are avoided. 

>
 

>
 

>
 

>
 

>