Iteration of Functions

Cobweb Plots

The following module produces a “Cobweb Plot”. (Code modified from https://community.wolfram.com/groups/-/m/t/153946)

cobwebPlot[f_,start_,n_,xrange:{xmin_,xmax_}]:=Module[{cob, coor,x,g1,g2},
cob=NestList[f,N[start],n];
coor = Partition[Riffle[cob,cob],2,1];
coor[[1,2]]=0;
g1=Graphics[{Purple,Line[coor]}];
g2=Plot[{x,f[x]},{x,xmin,xmax},PlotStyle->{Blue,Black}];
Show[{g1,g2},Frame->True]
]

Usage is: cobwebPlot[ function, starting value, number of iterates, {xmin, xmax} ], where xmin and xmax specify the domain to be plotted.

Try it out:

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

cobwebPlot[f[3.48],0.3,10000,{0,1}]

NestList[f[3.48],0.4,10000]

It looks like the sequence of iterates approaches a cycle of 4 values.

Bifurcation Diagram

Compute the long-term orbit (i.e., sequence of values) for a given r and starting value 0.1.

eventualOrbit[r_]:=Drop[ NestList[f[r], 0.1,500], 100]

This iterates the function 500 times, but then forgets the first 100 values. Try it out, and print the last 20 or so:

eventualOrbit[3.48][[380;;]]

We want to plot the values as pairs (r,x). So make the previous into a list of pairs:

column[r_]:={r,#} &/@ eventualOrbit[r]

Try it out:

column[3.48][[380;;]]

Now make a bifurcation diagram:

bifurcationPlot=Graphics[ {PointSize[0.001],Opacity[0.1],Point[ Flatten[ Table[column[r],{r,1,4,0.001}],1]]},AspectRatio->1/2,Frame->True ]