Superstability

Comparison of stable and superstable fixed points in the logistic map

Manipulate[Grid[{{
Show[Plot[{Nest[2# - 2((#)^2) &, x,k],2 x - 2 (x^2),x},{x,0,1},PlotStyle->{Blue,{Thickness[0.007],Red},Blue},Frame->True,PlotRange->{{0,1},{0,1}},AspectRatio->0.8,FrameLabel->{None,"(Subscript[x, n + 1])"}],Graphics[Flatten[MapIndexed[{Opacity[0.39],Line[{{#,If[#==x0,0,#]},{#,2 #-2 ((#)^2)}}],Line[{{#,2 #-2 ((#)^2)},{2 #-2 ((#)^2),2 #-2 ((#)^2)}}]}& ,NestWhileList[2 #-2 ((#)^2)&,x0,#1≠2 #2-2 ((#2)^2)&,2,n]]]],
Graphics[{Line[{{0.12,0.5},{0.7,0.5}}], Text[Style["|f'(x)| = 0",17],{0.3,0.56}]}],
ImageSize->330,LabelStyle->18],
ListLinePlot[NestList[2 #-2 ((#)^2)&,x0,n],FrameLabel->{None,"(Subscript[x, n])"},DataRange->{0,n},PlotRange->{0,1},Frame->True,Mesh->All,MeshStyle->{PointSize[Large],Red},PlotStyle->Gray,AspectRatio->0.8,ImageSize->330,LabelStyle->18]},
{Show[Plot[{Nest[r# - r((#)^2) &, x,k],r x - r (x^2),x},{x,0,1},PlotStyle->{Blue,{Thickness[0.007],Red},Blue},Frame->True,PlotRange->{{0,1},{0,1}},AspectRatio->0.8,FrameLabel->{"(Subscript[x, n])","(Subscript[x, n + 1])"}],Graphics[Flatten[MapIndexed[{Opacity[0.39],Line[{{#,If[#==x0,0,#]},{#,r #-r ((#)^2)}}],Line[{{#,r #-r ((#)^2)},{r #-r ((#)^2),r #-r ((#)^2)}}]}& ,NestWhileList[r #-r ((#)^2)&,x0,#1≠r #2-r ((#2)^2)&,2,n]]]],ImageSize->330,LabelStyle->18],
ListLinePlot[NestList[r #-r ((#)^2)&,x0,n],FrameLabel->{"n","(Subscript[x, n])"},DataRange->{0,n},PlotRange->{0,1},Frame->True,Mesh->All,MeshStyle->{PointSize[Large],Red},PlotStyle->Gray,AspectRatio->0.8,ImageSize->330,LabelStyle->18]}  }],
{k,{1,2,3},ControlType->Setter},
{{n,22},1,40,1,ImageSize->Large,Appearance->"Labeled"}, 
{{r,2.85},0,4,ImageSize->Large,Appearance->"Labeled"},  
{{x0,0.1, "(Subscript[x, 0])"},0,1,ImageSize->Large,Appearance->"Labeled"},
ControlPlacement->Bottom]

Creation of this notebook was supported by IT Academy program of Information Technology Foundation for Education (HITSA).