Logistic Map Bifurcations

MATH 242 Modern Computational Mathematics

Code from last class

The logistic map is the recurrence (Subscript[x, n+1])=r (Subscript[x, n])(1-(Subscript[x, n])), where 0<=r<=4 is a parameter. For any starting value 0<=(Subscript[x, 0])<=1, this recurrence defines a sequence of real numbers (Subscript[x, 0]),(Subscript[x, 1]),(Subscript[x, 2]),…. As last time, define (Subscript[f, r])(x)=r x(1-x):

f[r_][x_]:=r*x(1-x)

Recall that we can use NestList to compute logistic map trajectories:

NestList[f[0.8],0.4,20]

NestList[f[3.2],0.4,50]

ListPlot[%]

Furthermore, here is our cobweb plot module from last time:

cobwebPlot[f_,start_,numIter_,xmin_:0,xmax_:1]:=Module[
{cob={{start,0}},prev=start,next,g1,g2},

(* build the list of points to plot *)
Do[
next=f[prev];
AppendTo[cob,{prev,next}];
AppendTo[cob,{next,next}];
prev=next,
numIter];

(* display the plot *)
g1=Graphics[{Purple,Opacity[0.5],Line[cob]}];
g2=Plot[{x,f[x]},{x,xmin,xmax},PlotStyle->{Blue,Black}];
Show[{g1,g2},Frame->True]
]

cobwebPlot[f[3.2],0.32,200]

NestList[f[3.2],0.32,50]

cobwebPlot[f[2.8],0.32,200]

NestList[f[3.2],0.32,50]

cobwebPlot[f[3],0.32,200]

Fixed Points

Plot (Subscript[f, r])(x) together with the diagonal. What determines whether the fixed points are stable (attracting) or unstable (repelling)?

Manipulate[Plot[{f[r][x],x},{x,0,1},PlotRange->{0,1},AxesLabel->{"(Subscript[x, n])","(Subscript[x, n + 1])"}],{r,0,4}]

When a trajectory repeats every other value (that is, we observe a 2-cycle), we are actually observing a fixed point of (Subscript[f, r])((Subscript[f, r])(x)). To simplify our notation, let (Subscript[f, r]^((2)))(x)=(Subscript[f, r])((Subscript[f, r])(x)). Now make a plot of (Subscript[f, r]^((2)))(x).

Manipulate[Plot[{f[r][f[r][x]],x},{x,0,1},PlotRange->{0,1},AxesLabel->{"(Subscript[x, n])","(Subscript[x, n + 1])"}],{r,0,4}]

cobwebPlot[f[3.3],0.4,50]

NestList[f[3.3],0.4,50]

What happens when r>3.45?

How many more period-doubling bifurcations can you find? At what values of r do they occur?

NestList[f[3.47],0.4,100]

r = 3.47 appears to result in oscillation among 4 values

NestList[f[3.5],0.4,100]

r = 3.47 appears to result in oscillation among 4 values

NestList[f[3.52],0.4,100]

r = 3.52 appears to result in oscillation among 4 values

NestList[f[3.53],0.4,100]

r = 3.53 appears to result in oscillation among 4 values

cobwebPlot[f[3.53],0.4,100]

NestList[f[3.55],0.4,100]

r = 3.55 appears to result in oscillation among 8 values

Finding cycle values

Suppose a trajectory enters a cycle that oscillates among several values. How can we find good decimal approximations of the values in this long-term oscillation?

traj=NestList[f[3.53],0.4,200]

Select the last 20 (or so, it takes some experimentation) values in the trajectory:

tail=traj[[-20;;]]

Round[tail,0.0001]

DeleteDuplicates[Round[tail,0.0001]]

Try for r=3.55:

traj=NestList[f[3.55],0.4,300];
tail=traj[[-20;;]]
DeleteDuplicates[Round[tail,0.00001]]
Length[%]