The Lyapunov exponent for the logistic map, discussed in Lecture 41.  These commands can be used to produce all plots shown in class.

Numerical demonstration of the butterfly effect.

nt=300;
x=Table[0.0,{i,nt}];
r=3.6;
x[[1]]=0.37;
For[t=2,t<= nt,t++,
x[[t]]=r*x[[t-1]]*(1-x[[t-1]])];
x1=x;
x[[1]]=0.37+10^(-15);
For[t=2,t<= nt,t++,
x[[t]]=r*x[[t-1]]*(1-x[[t-1]])];
x2=x;
x[[1]]=0.37-10^(-15);
For[t=2,t<= nt,t++,
x[[t]]=r*x[[t-1]]*(1-x[[t-1]])];
x3=x;
ListPlot[{x1,x2,x3},PlotRange->All,AxesLabel->{"t","x"}]

Calculate the Lyapunov exponent.

ListPlot[{Log[Abs[x1-x2]],Log[Abs[x1-x3]]},PlotRange->All,AxesLabel->{"t","x"}]

fit=NonlinearModelFit[Log[Abs[x1-x2]],a*y+b,{a,b},y];
fit["BestFitParameters"]
fit["ParameterErrors"]

fit=NonlinearModelFit[Log[Abs[x1-x3]],a*y+b,{a,b},y];
fit["BestFitParameters"]
fit["ParameterErrors"]

Calculate lambda as a function of r, numerically.

$MinPrecision=35;
nt=25;
nr=1000;
x=Table[0.0,{i,nt},{j,nr}];
x2=Table[0.0,{i,nt},{j,nr}];
rarray=Table[0.0,{j,nr}];
λarray=Table[0.0,{j,nr}];
For[m=1,m<=nr,m++,
r=2.5+m*1.5/nr;
rarray[[m]]=r;
x[[1,m]]=0.37;
x2[[1,m]]=0.37+10^(-9);
For[t=2,t<= nt,t++,
x[[t,m]]=r*x[[t-1,m]]*(1-x[[t-1,m]]);
x2[[t,m]]=r*x2[[t-1,m]]*(1-x2[[t-1,m]])];
diff=Log[10^(-70.)+Abs[x[[;;,m]]-x2[[;;,m]]]];
fit=NonlinearModelFit[diff,a*y+b,{a,b},y];
λarray[[m]]=a/.fit["BestFitParameters"];
]; 

λ2array=Table[0.0,{j,nr}];
For[m=1,m<=nr,m++,
r=2.5+m*1.5/nr;
rarray[[m]]=r;
x[[1,m]]=0.87;
x2[[1,m]]=0.87+10^(-9);
For[t=2,t<= nt,t++,
x[[t,m]]=r*x[[t-1,m]]*(1-x[[t-1,m]]);
x2[[t,m]]=r*x2[[t-1,m]]*(1-x2[[t-1,m]])];
diff=Log[10^(-70.)+Abs[x[[;;,m]]-x2[[;;,m]]]];
fit=NonlinearModelFit[diff,a*y+b,{a,b},y];
λ2array[[m]]=a/.fit["BestFitParameters"];
]; 

rλ=Transpose@{rarray,λarray};
rλ2=Transpose@{rarray,λarray};
ListPlot[{rλ,rλ2},AxesLabel->{"r","λ"},PlotRange->{-0.8,0.8}]