Logistic Map Bifurcations  (by Iain Stewart)

?NestList

(* Define a function to carryout the iterations of the map function f  on initial value x0 for parameter r.  Iterate nmax time and then drop nmin terms. *)

fMaplist[r_,x0_,nmin_,nmax_]:=Module[{ylst,ylstd},
ylst=NestList[f[r],x0,nmax]; (* make a list by iterating f[r][x], starting on x=x0, with nmax iterations *)
ylstd=Drop[ylst,nmin];   (* get rid of first nmin points, x_0 to x_{nmin-1} *)
Table[{r,ylstd[[i]]},{i,1,Length[ylstd]}]    (* output a list of {r,x_n} pairs for n≥nmin *)
]

(* same thing but do not output list with the r value *)
fMaplistnor[r_,x0_,nmin_,nmax_]:=Module[{ylst,ylstd},
ylst=NestList[f[r],x0,nmax]; (* make a list by iterating f[r][x], starting on x=x0, with nmax iterations *)
ylstd=Drop[ylst,nmin]   (* get rid of first nmin points, x_0 to x_{nmin-1} *)
]

(* Note we can define a mapping function f[r][x] without having to reinitialize the above fMaplist and fMaplistnor commands *)

(* Logistic Map *)
Clear[f]
f[r_][x_]:=r*x*(1-x);

Plot[{x,f[3][x]},{x,0,1}]

(* output a few values to make sure everyting is working, here we use whatever the currently defined f is  *)
fMaplist[3.5,.1,2,5]

fMaplistnor[3.5,.1,2,5]

?ListPlot

(* Low precision plot, ie use a lower density for r values which is quicker *)
ListPlot[Table[fMaplist[r,.1,300,600],{r,3.4,4.0,.005}],PlotStyle->{{Black,PointSize[.0005]}}]

(* High precision *)
ListPlot[Table[fMaplist[r,.1,300,600],{r,3.4,4.0,.001}],PlotStyle->{{Black,PointSize[.0005]}}]

(* Plot to print *)
tmp=ListPlot[Table[fMaplist[r,.1,300,600],{r,2.9,4.0,.001}],PlotStyle->{{Black,PointSize[.001]}},AxesLabel->{"r","x"},
LabelStyle->18]

Export["~/8.09/Logistic_Map.eps",tmp]

Export["~/8.09/Logistic_Map.pdf",tmp]