Analysis of the Lorenz map

Manipulate[Module[{sol,pts,a,x,y,z,maxPts},{{sol},{pts}}=Reap@NDSolve[{{x'[t]==σ (y[t]-x[t]),y'[t]==x[t] (r-z[t])-y[t],z'[t]== x[t] y[t] -b z[t],x[0]== 19,y[0]== 20,z[0]== 50},WhenEvent[z'[t]==0,Sow[t]]},{x,y,z},{t,0,tmax},MaxSteps-> Infinity,Method->"StiffnessSwitching"];
z=z/.sol;maxPts=Last/@Partition[Drop[pts,51],2];
a=Map[z,{Most@maxPts,Rest@maxPts}\[Transpose]];
Pane[Switch[ctrl,
1,ListPlot[a,PlotStyle-> {PointSize[0.006],Red},Epilog->{Blue,Line[{{0,0},{100,100}}]},AspectRatio->1,Frame->True,GridLines->None,FrameLabel->{"(Subscript[z, n])","(Subscript[z, n + 1])"},LabelStyle->15,ImageSize->Large],
2,Plot[z[t],{t,80,tmax},PlotRange->All,PlotStyle-> Blue,Epilog->{Red,PointSize[0.011],Point[{#,z[#]}&/@maxPts]},AspectRatio->1,Frame->True,GridLines->None,FrameLabel->{"t","z(t)"},LabelStyle->15,ImageSize->Large]
],ImageSize->Automatic]],
{{σ ,16,"σ"},6,20,0.0001,Appearance->"Labeled"},
{{r,45.92,Style["r", Italic]},22,56,0.0001,Appearance->"Labeled"},
{{b,4,Style["b", Italic]},1.0,4.5,0.0001,Appearance->"Labeled"},
{{tmax,100,"Time t"},81,200,1,Appearance->"Labeled"},
{{ctrl,1,""},{1-> "Lorenz map",2-> "time series"}},
TrackedSymbols:>{ctrl,r,b,σ ,tmax},SynchronousUpdating->False]

Credit: Based on code writen by: Housam Binous, Ahmed Bellagi, and Brian G. Higgins

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