The logistic map, discussed in Lecture 36.  These commands can be used to produce all plots shown in class.

For small r, all dynamics relax to the same state.

nt=100;
x=Table[0.0,{i,nt}];
r=1.1;
x[[1]]=0.4;
For[t=2,t<= nt,t++,
x[[t]]=r*x[[t-1]]*(1-x[[t-1]])];
x1=x;
x[[1]]=0.82;
For[t=2,t<= nt,t++,
x[[t]]=r*x[[t-1]]*(1-x[[t-1]])];
x2=x;
x[[1]]=0.01;
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"}]

For intermediate r, we start to see a period-2 cycle.

nt=100;
x=Table[0.0,{i,nt}];
r=3.1;
x[[1]]=0.4;
For[t=2,t<= nt,t++,
x[[t]]=r*x[[t-1]]*(1-x[[t-1]])];
x1=x;
x[[1]]=0.82;
For[t=2,t<= nt,t++,
x[[t]]=r*x[[t-1]]*(1-x[[t-1]])];
x2=x;
x[[1]]=0.01;
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"}]

For large r, we see chaos.

nt=1000;
x=Table[0.0,{i,nt}];
r=3.77;
x[[1]]=0.4;
For[t=2,t<= nt,t++,
x[[t]]=r*x[[t-1]]*(1-x[[t-1]])];
x1=x;
x[[1]]=0.82;
For[t=2,t<= nt,t++,
x[[t]]=r*x[[t-1]]*(1-x[[t-1]])];
x2=x;
x[[1]]=0.01;
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"}]

This historical classic of a plot depicts the states the logistic map settles down to (after throwing away transients due to initial conditions.  The onset of chaos appears as the destruction of stable period-2^n cycles.

nt=200;
nr=1000;
x=Table[0.0,{i,nt},{j,nr}];
rarray=Table[0.0,{i,nt},{j,nr}];
For[m=1,m<=nr,m++,
r=m*4.0/nr;
x[[1,m]]=0.37;
For[t=2,t<= nt,t++,
x[[t,m]]=r*x[[t-1,m]]*(1-x[[t-1,m]])];
x[[1,m]]=x[[nt,m]];
rarray[[1,m]]=r;
For[t=2,t<= nt,t++,
x[[t,m]]=r*x[[t-1,m]]*(1-x[[t-1,m]]);
rarray[[t,m]]=r;
]; 
];
x0=ArrayReshape[x,{nt*nr}];
r0=ArrayReshape[rarray,{nt*nr}];
rx=Transpose@{r0,x0};
ListPlot[rx,AxesLabel->{"r","x"},PlotRange->All]

Zoom in on the self-similar structures...

nt=200;
nr=1000;
x=Table[0.0,{i,nt},{j,nr}];
rarray=Table[0.0,{i,nt},{j,nr}];
For[m=1,m<=nr,m++,
r=m*0.01/nr+3.566;
x[[1,m]]=0.37;
For[t=2,t<= nt,t++,
x[[t,m]]=r*x[[t-1,m]]*(1-x[[t-1,m]])];
x[[1,m]]=x[[nt,m]];
rarray[[1,m]]=r;
For[t=2,t<= nt,t++,
x[[t,m]]=r*x[[t-1,m]]*(1-x[[t-1,m]]);
rarray[[t,m]]=r;
]; 
];
x0=ArrayReshape[x,{nt*nr}];
r0=ArrayReshape[rarray,{nt*nr}];
rx=Transpose@{r0,x0};
ListPlot[rx,AxesLabel->{"r","x"},PlotRange->{0.33,0.4}]

nt=200;
nr=1000;
x=Table[0.0,{i,nt},{j,nr}];
rarray=Table[0.0,{i,nt},{j,nr}];
For[m=1,m<=nr,m++,
r=m*0.004/nr+3.568;
x[[1,m]]=0.37;
For[t=2,t<= nt,t++,
x[[t,m]]=r*x[[t-1,m]]*(1-x[[t-1,m]])];
x[[1,m]]=x[[nt,m]];
rarray[[1,m]]=r;
For[t=2,t<= nt,t++,
x[[t,m]]=r*x[[t-1,m]]*(1-x[[t-1,m]]);
rarray[[t,m]]=r;
]; 
];
x0=ArrayReshape[x,{nt*nr}];
r0=ArrayReshape[rarray,{nt*nr}];
rx=Transpose@{r0,x0};
ListPlot[rx,AxesLabel->{"r","x"},PlotRange->{0.36,0.39}]