(*Wykres bifurkacji dla odwzorowania logistycznego*)
lmin=2.;lmax=4.;k=5000;nmin=10000;nmax=11000;

l=Range[lmin,lmax,(lmax-lmin)/k];

(*Rekurencje.*)

(*Zaokrąglenie wprowadziłem ze względu na to, że próbkujemy odwzorowanie dla skończonych n i część atraktorów może mieć sztucznie różną wartość.*)
(*Union wypisuje wszystkie występujące atraktory*)

Bifun[par_]:=Module[{tab1},tab1=RecurrenceTable[{x[n+1]==par*x[n]*(1-x[n]),x[0]==0.01},x,{n,nmin,nmax}];
tab1=Round[tab1,(lmax-lmin)/k];Union[tab1]]

Temp1=Table[Bifun[l[[i]]],{i,Length[l]}];

Dane=Flatten[Table[{l[[i]],Temp1[[i]][[j]]},{i,Length[l]},{j,Length[Temp1[[i]]]}],1];

(*Szukanie punktów bifurkacji*)
BifCoord[ord_]:=Module[{tab1,pos,val},tab1=Table[Length[Temp1[[i]]],{i,Length[l]}];
pos=Position[tab1,ord][[1]];
l[[pos]][[1]]]

ListPlot[Dane,GridLines->{{BifCoord[2],BifCoord[4],BifCoord[8],BifCoord[16]},None},PlotRange->{{2,4},{0,1}},ImageSize->Scaled[0.95],PlotStyle->{PointSize->0.0001,Black,GrayLevel[0.4],Opacity[0.1]}]