Logistic map - bifurcations

Clear["Global`*"]

Fixed Points

f[x_]=r x (1-x)
Plot[{x,f[x]/.r->2},{x,0,1}]
FixedPoints=Solve[f[x]==x,x]

fp1=x/.FixedPoints[[1]];
fp2=x/.FixedPoints[[2]];
Plot[{fp1,fp2},{r,0,4}, PlotRange->{{0,4},{0,1}},AxesOrigin->{0,0.5}, AxesLabel->{"r","x*"}]

Stability

df[x_]=D[f[x],x];
dfp1=df[fp1]
dfp2=df[fp2] //Simplify
Reduce[Abs[dfp2]≤1&&r>0,r]   (* stability condition *)

R0=1;
R1=3;
plot0s=Plot[fp1,{r,0,1},PlotStyle->{Blue}];
plot0u=Plot[fp1,{r,1,4},PlotStyle->{Red}];
plot1s=Plot[fp2,{r,1,R1},PlotStyle->{Blue}];
plot1u=Plot[fp2,{r,R1,4},PlotStyle->{Red}];
bplot1=Show[plot0s,plot0u,plot1s,plot1u, PlotRange->All, AxesOrigin->{0,0.5}]

Evolution Example

fr[x_]=f[x]/.{r->2}
orbit=NestList[fr,0.1,10]
ListPlot[orbit, Joined->True]

Period - 2

f2[x_]=Nest[f,x,2]
f2[x]  //Expand
Plot[{x,f2[x]/.r->2},{x,0,1}]
Plot[{x,f2[x]/.r->3.2},{x,0,1}]

period2points=Solve[f2[x]==x,x]

p21=x/.period2points[[3]] //Simplify
p22=x/.period2points[[4]]//Simplify
Reduce[-3-2 r+(r^2)≥0&&r>0,r]

Stability

df2[x_]=D[f2[x],x];
dp12=df2[p21] //Simplify
dp22=df2[p22]  //Simplify
Reduce[Abs[dp12]≤1&&r>0,r]   (* stability condition *)

R2=1+(Sqrt[6]);
plot2s1=Plot[p21,{r,R1,R2},PlotStyle->{Blue}];
plot2s2=Plot[p22,{r,R1,R2},PlotStyle->{Blue}];
plot2u1=Plot[p21,{r,R2,4},PlotStyle->{Red}];
plot2u2=Plot[p22,{r,R2,4},PlotStyle->{Red}];
bplot2=Show[plot2s1,plot2s2,plot2u1,plot2u2,bplot1,PlotRange->All, AxesOrigin->{0,0.5}]

Evolution Example

fr[x_]=f[x]/.{r->3.2}
orbit=NestList[fr,0.1,30]
ListPlot[orbit, Joined->True]

Period - 4

f4[x_]=Nest[f,x,4]
f4[x]  //Expand
Plot[{x,f4[x]/.r->3.1},{x,0,1}]
Plot[{x,f4[x]/.r->3.5},{x,0,1}]

period4points=Solve[f4[x]==x,x]

Particular solution

p41=x/.period4points[[5]];
ptmp=Plot[p41,{r,0,4}, PlotRange->{{0,3.9},{0,1}}]

Stability

df4[x_]=D[f4[x],x];
dp41=df4[p41];
Plot[{dp41,-1},{r,R2,3.96}]

sol=FindRoot[dp41==-1,{r,3.55}];
R3=r/.sol[[1]]

Evolution Example

fr[x_]=f[x]/.{r->3.54}
orbit=NestList[fr,0.1,30]
ListPlot[orbit, Joined->True]

Plot Bifurcation diagram

p4=x/.period4points[[5]];
plot411=Plot[p4,{r,R2,R3},  PlotStyle->Blue];
plot412=Plot[p4,{r,R3,3.96},  PlotStyle->Red];
p4=x/.period4points[[6]];
plot421=Plot[p4,{r,R2,R3},  PlotStyle->Blue];
plot422=Plot[p4,{r,R3,3.96},  PlotStyle->Red];
p4=x/.period4points[[7]];
plot431=Plot[p4,{r,R2,R3},  PlotStyle->Blue];
plot432=Plot[p4,{r,R3,3.96},  PlotStyle->Red];
p4=x/.period4points[[8]];
plot441=Plot[p4,{r,R2,R3},  PlotStyle->Blue];
plot442=Plot[p4,{r,R3,3.96},  PlotStyle->Red];
bplot4=Show[bplot2,plot411,plot412,plot421,plot422,plot431,plot432,plot441,plot442]