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]

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.3],Line[cob]}];
g2=Plot[{x,f[x]},{x,xmin,xmax},PlotStyle->{Blue,Black}];
Show[{g1,g2},Frame->True]
]

Fixed Points

First, plot plot (Subscript[f, r])(x) together with the diagonal.

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

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

NestList[f[r],0.3,40]

What happens if r>3.45?

r=3.5;
traj=NestList[f[3.5],0.3,100]

ListPlot[traj]

cobwebPlot[f[r],0.3,500]

Try r=3.55:

r=3.55;
traj=NestList[f[r],0.3,200]

ListPlot[traj]

Take the last 50 values:

tail=traj[[-50;;]]

DeleteDuplicates[tail]

DeleteDuplicates[Round[tail,0.001]]
Length[%]

Try r=3.56:

r=3.56;
traj=NestList[f[r],0.3,200]

tail=traj[[-50;;]]

DeleteDuplicates[Round[tail,0.001]]
Length[%]

Try r=3.567:

r=3.567;
traj=NestList[f[r],0.3,500];
tail=traj[[-100;;]]
DeleteDuplicates[Round[tail,0.0001]]
Length[%]