Lorenz Attractor

Manipulate[Clear[x,y,z,t];
Module[{soln},
With[{b=bb,σ=σσ,r=rr,x0=xx0,y0=yy0,z0=zz0},soln=Quiet@NDSolve[SetPrecision[{x'[t]==σ (-x[t]+y[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},Infinity],{x[t],y[t],z[t]},{t,0,tt},PrecisionGoal->ControlActive[4,8],WorkingPrecision->ControlActive[MachinePrecision,20]];ParametricPlot3D[Evaluate[{x[t],y[t],z[t]}/.soln],{t,0,soln[[1,1,2,0,1,1,2]]},PlotPoints->ControlActive[100,200],MaxRecursion->ControlActive[4,6],Axes->False,Boxed->False,ImageSize->{400,400},PlotRange->All]]],{{tt,10,"time"},1,35,.01,ImageSize->Small,Appearance->"Labeled"},
Delimiter,
Style["parameters",Bold],
{{bb,8/3,"b"},0,10,.01,ImageSize->Small,Appearance->"Labeled"},{{σσ,10,"σ"},0,100,.01,ImageSize->Small,Appearance->"Labeled"},{{rr,28,"r"},0,100,.01,ImageSize->Small,Appearance->"Labeled"},Delimiter,Style["initial conditions",Bold],
{{xx0,1,"(Subscript[x, 0])"},1,200,.01,ImageSize->Small,Appearance->"Labeled"},{{yy0,5,"(Subscript[y, 0])"},1,200,.01,ImageSize->Small,Appearance->"Labeled"},{{zz0,10,"(Subscript[z, 0])"},1,200,.01,ImageSize->Small,Appearance->"Labeled"},ControlPlacement->Left,AutorunSequencing->{3,4,5},TrackedSymbols->Manipulate]

The Lorenz attractor, originating in atmospheric science, became the prime example of a chaotic system.

Due to the high precision numerical calculations involved in faithfully representing chaotic systems, this Demonstration should only be regarded as qualitatively correct, not quantitatively.

Contributed by: Rob Morris