Analysis of the Lorenz map

tmax=7;x0=6.1;y0=6;z0=10;
d=10;
r=28.14;
b=8/3;
soln=NDSolve[{
x'[t]==d (y[t]-x[t]),y'[t]==r x[t]-y[t]-x[t] z[t],z'[t]==x[t] y[t]-b z[t],
x[0]==x0,y[0]==y0,z[0]==z0},{x,y,z},{t,0,tmax},MaxSteps->Infinity];
diffx=d (y-x);diffy=r x-y-x z;diffz=x y-b z;
fixedpoints=Quiet[Solve[{diffx==0,diffy==0,diffz==0},{x,y,z}]];
coordinates={y,z}/.fixedpoints;
Gfp=Graphics[{PointSize[0.03],Red,Point[coordinates]}];
pplot=ParametricPlot[Evaluate[{y[t],z[t]}/.soln],{t,0,tmax},PlotPoints->1000,Frame->True,FrameLabel->{y[t],z[t]},LabelStyle->20,ImageSize->330];
tdp=Plot[Evaluate[z[t]/.soln],{t,0,tmax},Frame->True,FrameLabel-> {t,z[t]},PlotRange-> All,ImageSize->410,LabelStyle->20,Epilog->Style[{Text[(Subscript[z, n]),{1.8,42.5}], Text[(Subscript[z, n+1]),{2.72,42.9}]},24]];
Row[{Show[pplot,Gfp],tdp},"                          "]

Clear[x0,r,z,iter]
cobweb[r_,z_,x0_,iter_]:=Quiet[Module[{data1,data2}, 
With[{p=NestList[(r (1-(Sqrt[Abs[#]]))/2-1)&,x0,iter]}, 
data1=Union[{{0,p[[1]],0}}, Table[{2i-1,p[[i]],p[[i+1]]},{i,1,Length[p]-1,1}], Table[{2i,p[[i+1]],p[[i+1]]},{i,1,Length[p]-1,1}]];
data2=Table[{data1[[i,2]],data1[[i, 3]]},{i,1,Length[data1]-1,1}]]]];
Manipulate[Quiet[Module[{gr1,gr2,gr3},
gr1=Plot[{x,r (1-(Sqrt[Abs[x]]))/2-1},{x,-1,1},PlotRange->{{-1,1},{-1,1}},PlotStyle->{{Blue},{Thickness[0.008],Red}}];
gr2=ListPlot[cobweb[r,z,x0,iter],Joined->True,PlotStyle->{GrayLevel[0.],Opacity[0.35]}];
gr3=ListLinePlot[NestList[r (1-(Sqrt[Abs[#]]))/2-1&,x0,iter],DataRange->{0,iter},FrameLabel->{"n","(Subscript[z, max])"},PlotRange->{-1,1},Frame->True,Mesh->All,MeshStyle->{PointSize[Large],Red},PlotStyle->Gray,AspectRatio->0.8,ImageSize->430,LabelStyle->18];
Row[{Show[gr1,gr2,Frame->True,FrameLabel->{"(Subscript[z, n])","(Subscript[z, n + 1])"},AspectRatio-> 0.8,ImageSize->430,LabelStyle->18],gr3},"      "]]
], 
Control[{{r,4,"Parameter value, r"},1,4,0.0001,ImageSize->Large,Appearance->"Labeled"}],
Control[{{x0,-0.5,"Initial value, (Subscript[x, 0])"},-1,1,0.0001,ImageSize -> Large,Appearance->"Labeled"}],
Control[{{iter,50,"Iterations, n"},1,500,1,ImageSize->Large,Appearance->"Labeled"}],
FrameMargins-> None,ControlPlacement->Bottom,SaveDefinitions->True]

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