f[x_]:=l*x(1-x);
f[l_,x_]:=l*x(1-x)
(* l=2.95 *)
xf =  x /. Solve[f[x]==x,x][[2]];

Clear[plot1,plot2,xl2,xt,xl2];
plot1[l_]:=Plot[{f[l,x],x},{x,0,1},AspectRatio->1];
plot2[l_]:=Plot[{f[l,f[l,x]],x},{x,0,1},AspectRatio->1,PlotStyle->Thick];
plot3[l_]:=Plot[{f[l,f[l,f[l,x]]],x},{x,0,1},AspectRatio->1,PlotStyle->Thick];
plot4[l_]:=Plot[{f[l,f[l,f[l,f[l,x]]]],x},{x,0,1},AspectRatio->1,PlotStyle->Thick];
plot6[l_]:=Plot[{f[l,f[l,f[l,f[l,f[l,f[l,x]]]]]],x},{x,0,1},AspectRatio->1,PlotStyle->Thick];
plot8[l_]:=Plot[{f[l,f[l,f[l,f[l,f[l,f[l,f[l,f[l,x]]]]]]]],x},{x,0,1},AspectRatio->1,PlotStyle->Thick];
xl=ParametricPlot[{xf,t},{t,0,1}];
xl2[x_]:=ParametricPlot[{1-(xf /. l->x),t},{t,0,1}];
xt[l_]:=ParametricPlot[{f[l,.5],t},{t,0,1}];
xhor[x_]:=ParametricPlot[{t,(xf /. l->x)},{t,0,1}];
1+Sqrt[6.]

(* Show[plot1,plot2,xl,xl2,xt]*)
(*Manipulate[Show[plot1[l],plot2[l],xl2[l],xt[l],xhor[l]],{l,2,1 + Sqrt[6]}]*)
GraphicsRow[{Manipulate[Show[plot1[l],plot2[l]],{l,2,1 + Sqrt[6]}],Manipulate[Show[plot1[l],plot4[l]],{l,2,1 + Sqrt[6]}]},Frame->All,ImageSize->Full]
GraphicsRow[{Manipulate[Show[plot1[l],plot2[l]],{l,2,3.7}],Manipulate[Show[plot1[l],plot4[l]],{l,2,3.7}]},Frame->All,ImageSize->Full]
GraphicsRow[{Manipulate[Show[plot1[l],plot4[l]],{l,2,3.7}],Manipulate[Show[plot1[l],plot8[l]],{l,2,3.7}]},Frame->All,ImageSize->Full]
GraphicsRow[{Manipulate[Show[plot1[l],plot3[l]],{l,2,3.9}],Manipulate[Show[plot1[l],plot6[l]],{l,2,3.9}]},Frame->All,ImageSize->Full]

ss = 2.98;
plotf = Plot[f[ss,x],{x,0,1},AspectRatio->.8,PlotRange->{0,1}];
plotId = Plot[x,{x,0,1}];
Show[plotf,plot2[ss],plotId,xl2[ss],xt[ss],xhor[ss]]
Export["LogisticMapSq23.eps",%]

Clear[l];
g[x_]:=Expand[f[f[x]]]
FindMaximum[g[x]/. l->2.9,x]
Manipulate[Show[Plot[g[x]/. l->t,{x,0,1},PlotRange->{0,1}],Plot[x,{x,0,1}]],{t,2,3}]

Plot[Expand[D[g[x],{x,1}]]/. x->1/l,{l,2,3}]

(Expand[D[D[f[f[x]],x],x]]/. x->1/l)/. l->2.1

Simplify[%]

g[x]
Solve[D[g[x],x]==0,x]
Solve[D[g[x],{x,2}]==0,x]

Solve[D[g[x],x]==0,x]

Solve[D[g[x],{x,2}]==0,x]

Plot[((3 l-(Sqrt[3]) (Sqrt[-2 l+(l^2)]))/(6. l))-1/l,{l,2,3}]

Plot[D[f[f[x]],x] /. x->((3 l+(Sqrt[3]) (Sqrt[-2 l+(l^2)]))/(6. l)),{l,2,3}]

D[g[x],{x,1}]

Simplify[(l^2)-2 (l^2) x-2 (l^3) x+6 (l^3) (x^2)-4 (l^3) (x^3) /. x->((3 l+(Sqrt[3]) (Sqrt[-2 l+(l^2)]))/(6 l))]

Solve[D[g[x],{x,2}]==0,x]

Plot[%,{l,2,3}]

crit=Flatten[Solve[D[g[x],{x,2}]==0,x]]

Manipulate[{D[g[x],x]/. crit[[2]] /. l->t,D[g[x],x]/. crit[[1]] /. l->t,D[g[x],x]/. x->f[1/2]/. l->t,D[g[x],x]/. x->1/l/. l->t},{t,2,3}]

Solve[1/l==l*x(1-x),x]

Plot[(((l^2)+l (Sqrt[-4+(l^2)]))/(2 (l^2)))-l/4 ,{l,2,3},PlotRange->{-.001,.2}]

Plot[l^3/4-l^4/16,{l,2,3}]

h[x_]:= x/4 + 450;
h[700.]
h[%]
h[%]
h[%]
h[%]
h[%]
h[%]
h[%]
h[%]
h[%]
h[%]
h[%]
h[%]

plot1[l_]:=Plot[{f[l,x],x},{x,0,1},AspectRatio->1,PlotStyle->Green];
plot2[l_]:=Plot[{f[l,f[l,x]],x},{x,0,1},AspectRatio->1,PlotStyle->Red];plot3[l_]:=Plot[{f[l,f[l,f[l,f[l,x]]]],x},{x,0,1},AspectRatio->1,PlotStyle->{Thick,Blue}];
plot4[l_]:=Plot[{f[l,f[l,f[l,f[l,f[l,f[l,f[l,f[l,x]]]]]]]],x},{x,0,1},AspectRatio->1,PlotStyle->{Thick,Blue}];
Manipulate[Show[plot1[l],plot2[l]],{l,2.5,3.5}]
Manipulate[Show[plot1[l],plot2[l],plot3[l]],{l,3,3.75}]
Print["The parameter value for one plus root 6 is: ",N[1+Sqrt[6]]]
Manipulate[Show[plot1[l],plot2[l],plot4[l]],{l,3,3.75}]

plot3s[l_]:=Plot[{f[l,f[l,f[l,x]]],x},{x,0,1},AspectRatio->1,PlotStyle->{Thick,Blue}];
plot6s[l_]:=Plot[{f[l,f[l,f[l,f[l,f[l,f[l,x]]]]]],x},{x,0,1},AspectRatio->1,PlotStyle->{Red}];
Manipulate[Show[plot3s[l]],{l,3,3.9}]
Manipulate[Show[plot3s[l],plot6s[l]],{l,3,3.9}]

bottomLine = Plot[-x^3/16+x^2/4,{x,3.5,4},PlotRange->{0,1}];
bottomLine = Plot[f[l/4],{l,3.5,4},PlotRange->{0,1}];
midLine1 = Plot[f[f[l/4]],{l,3.5,4},PlotRange->{0,1}];
midline2 = Plot[f[f[f[l/4]]],{l,3.5,4},PlotRange->{0,1}];
topLine = Plot[l/4,{l,3.5,4},PlotRange->{0,1}];
Show[bottomLine,midLine1,midline2,topLine]

newLine1 = Plot[f[f[f[f[l/4]]]],{l,3.5,4},PlotRange->{0,1}];
newLine2 = Plot[f[f[f[f[f[l/4]]]]],{l,3.5,4},PlotRange->{0,1}];
newLine3 = Plot[f[f[f[f[f[f[l/4]]]]]],{l,3.5,4},PlotRange->{0,1}];
newLine4 = Plot[f[f[f[f[f[f[f[l/4]]]]]]],{l,3.5,4},PlotRange->{0,1}];
Show[bottomLine,midLine1,midline2,topLine,newLine1,newLine2,newLine3,newLine4]

λ = 2.8;
plotf2=Plot[{f[λ,f[λ,x]],x,f[λ,x]},{x,0,1},PlotRange->{{0,1},{0,1}},AspectRatio->.9,PlotStyle->Thick,Ticks->None];
p1 = Graphics[{PointSize[Large],Red,Point[{1-1/λ,f[λ,1-1/λ]}]}];
Show[plotf2,p1]
Export["f28andf228.eps",%]
λ = 3.0;
plotf=Plot[f[λ,x],{x,0,1},PlotRange->{{0,1},{0,1}},AspectRatio->.9,PlotStyle->Thick];
plotf2=Plot[{f[λ,f[λ,x]],x,f[λ,x]},{x,0,1},PlotRange->{{0,1},{0,1}},AspectRatio->.9,PlotStyle->Thick,Ticks->None];
p1 = Graphics[{PointSize[Large],Red,Point[{1-1/λ,f[λ,1-1/λ]}]}];
Show[plotf2,p1]
Export["f3andf23.eps",%]
λ = 3.2;
plotf=Plot[f[λ,x],{x,0,1},PlotRange->{{0,1},{0,1}},AspectRatio->.9,PlotStyle->Thick];
plotf2=Plot[{f[λ,f[λ,x]],x,f[λ,x]},{x,0,1},PlotRange->{{0,1},{0,1}},AspectRatio->.9,PlotStyle->Thick,Ticks->None];
p1 = Graphics[{PointSize[Large],Red,Point[{1-1/λ,f[λ,1-1/λ]}]}];
Show[plotf2,p1]
Export["f32andf232.eps",%]

λ = 1+Sqrt[6]-.08;
N[λ]
N[1+Sqrt[6]]
N[1+Sqrt[6]+.08]
plotf2=Plot[{f[λ,f[λ,f[λ,f[λ,x]]]],x,f[λ,f[λ,x]]},{x,0,1},PlotRange->{{0,1},{0,1}},AspectRatio->.9,PlotStyle->Thick,Ticks->None];
p1 = Graphics[{PointSize[Large],Red,Point[{1-1/λ,f[λ,1-1/λ]}]}];
Show[plotf2,p1]
Export["f2bandf4b.eps",%]
λ = 1+Sqrt[6];
plotf2=Plot[{f[λ,f[λ,f[λ,f[λ,x]]]],x,f[λ,f[λ,x]]},{x,0,1},PlotRange->{{0,1},{0,1}},AspectRatio->.9,PlotStyle->Thick,Ticks->None];
p1 = Graphics[{PointSize[Large],Red,Point[{1-1/λ,f[λ,1-1/λ]}]}];
Show[plotf2,p1]
Export["f2dandf4d.eps",%]
λ = 1+Sqrt[6]+.08;
plotf2=Plot[{f[λ,f[λ,f[λ,f[λ,x]]]],x,f[λ,x]},{x,0,1},PlotRange->{{0,1},{0,1}},AspectRatio->.9,PlotStyle->Thick,Ticks->None];
p1 = Graphics[{PointSize[Large],Red,Point[{1-1/λ,f[λ,1-1/λ]}]}];
Show[plotf2,p1]
Export["f2aandf4a.eps",%]

Plot[{2*Pi*Sin[x],x},{x,-Pi,Pi},PlotStyle->Thick]