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,Opacity[0.2],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.

Define a function:

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

cobwebPlot[ f[3.84], 0.3, 1000, {0,1}]

NestList[f[3.84],0.3,200]

Bifurcation Diagram

Define a function to compute the “orbit” for a given r and starting value 0.1. Iterate 500 times, then throw away the first 100 values.

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

eventualOrbit[3.2][[;;20]]

Define a function to convert the previous values into points (r,x):

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

column[3.2][[;;20]]

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