Attractor reconstruction

Ex: Sine wave

Clear[t,d,tmax]
signal=Sin[t];
Plot[signal,{t,0,12 π},FrameLabel->{t,"f(t)"},Frame->True, LabelStyle->18,ImageSize->500]
Manipulate[
Column[{
Plot[Sin[t],{t,0,tmax},FrameLabel->{t,"f(t)"},Frame->True,AspectRatio->0.2, LabelStyle->18,ImageSize->500],
ParametricPlot[{signal,Sin[t+d]},{t,0,tmax},AxesLabel->{f[t],f[t+d]},ImageSize->500,LabelStyle->18,PerformanceGoal->"Quality"]}],
{{d,0.1,"Delay τ"},0,Pi,Appearance->"Labeled"},
{{tmax,1,"Time t"},1,2 Pi,Appearance->"Labeled"},
SaveDefinitions->True,TrackedSymbols:>{d,tmax}]

Ex: Quasiperiodic time-series

Clear[d2,tmax2]
signal=3 Sin[θ]+Sin[(Sqrt[2]) θ];(*quasiperiodic signal*)
Plot[signal,{θ,0,45 π},FrameLabel->{θ,"f(θ)"},Frame->True, LabelStyle->18,ImageSize->500]
Manipulate[Column[{
Plot[3 Sin[θ]+Sin[(Sqrt[2]) θ],{θ,0,tmax2},FrameLabel->{θ,"f(θ)"},Frame->True,AspectRatio->0.2, LabelStyle->18,ImageSize->500],
ParametricPlot[{signal,3 Sin[θ+d2]+Sin[(Sqrt[2]) (θ+d2)]},{θ,0,tmax2},AxesLabel->{f[θ],f[θ+d2]},ImageSize->500,LabelStyle->18,PerformanceGoal->"Quality"]}],
{{d2,1.4,"Delay τ"},0,11,Appearance->"Labeled"},
{{tmax2,100,"Time/angle θ"},4,220,Appearance->"Labeled"},
SaveDefinitions->True,TrackedSymbols:>{d2,tmax2}]

Clear[t,d3,tmax]
Manipulate[Column[{
Plot[3 Sin[θ]+Sin[(Sqrt[2]) θ],{θ,0,tmax},FrameLabel->{θ,"f(θ)"},Frame->True,AspectRatio->0.2, LabelStyle->18,ImageSize->500],
ParametricPlot3D[{3 Sin[θ]+Sin[(Sqrt[2]) θ],3 Sin[θ+d3]+Sin[(Sqrt[2]) (θ+d3)],3 Sin[θ+2 d3]+Sin[(Sqrt[2]) (θ+2 d3)]},{θ,0,tmax},AxesLabel->{f[θ],f[θ+d3],f[θ+2 d3]},ImageSize->Large,LabelStyle->18]}],
{{d3,4,"Delay τ"},0,11 ,Appearance->"Labeled"},
{{tmax,100,"Time/angle θ"},4,300,Appearance->"Labeled"},
SaveDefinitions->True,TrackedSymbols:>{d3,tmax}]

Ex: The Lorenz attractor, using x time-series

Clear[t,d,tmax,tau,x,y,z]
Manipulate[
x0=6.1;y0=6;z0=10;d=10;r=28.24;b=8/3;
sol=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];
Column[{
Plot[Evaluate[x[t]/.sol],{t,0,tmax},ImageSize->530,LabelStyle->16,AxesLabel-> {t,x[t]},AspectRatio->0.2],
ParametricPlot3D[Evaluate[{x[t],x[t+tau],x[t+2 tau]}/.sol],{t,0,tmax},ImageSize->530,PlotPoints->100,LabelStyle->16,PerformanceGoal->"Quality",AxesLabel-> {x[t],x[t+tau],x[t+2 tau]}]}],
{{tmax,60,"Time t"},5,100,ImageSize->Large,Appearance->"Labeled"},
{{tau,0.1,"Delay τ"},0,1.0,ImageSize->Large,Appearance->"Labeled"},
SaveDefinitions->True,TrackedSymbols:>{tmax,tau}]

Ex: The Lorenz attractor, using y time-series

Clear[t,d,tmax,tau,x,y,z]
Manipulate[
x0=6.1;y0=6;z0=10;d=10;r=28;b=8/3;
sol=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];
Column[{
Plot[Evaluate[y[t]/.sol],{t,0,tmax},ImageSize->530,LabelStyle->16,AxesLabel-> {t,y[t]},AspectRatio->0.2],
ParametricPlot3D[Evaluate[{y[t],y[t+tau], y[t+2 tau]}/.sol],{t,0,tmax},ImageSize->530,PlotPoints->100,LabelStyle->16,PerformanceGoal->"Quality",AxesLabel-> {y[t],y[t+tau],y[t+2 tau]}]}],
{{tmax,60,"Time t"},5,100,ImageSize->Large,Appearance->"Labeled"},
{{tau,0.1,"Delay τ"},0,1.0,ImageSize->Large,Appearance->"Labeled"},
SaveDefinitions->True,TrackedSymbols:>{tmax,tau}]

Ex: The Lorenz attractor, using z time-series

Clear[t,d,tmax,tau,x,y,z]
Manipulate[
x0=6.1;y0=6;z0=10;d=10;r=28.24;b=8/3;
sol=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];
Column[{
Plot[Evaluate[z[t]/.sol],{t,0,tmax},ImageSize->530,LabelStyle->16,AxesLabel-> {t,z[t]},AspectRatio->0.2],
ParametricPlot3D[Evaluate[{z[t],z[t+tau], z[t+2 tau]}/.sol],{t,0,tmax},ImageSize->530,PlotPoints->100,LabelStyle->16,PerformanceGoal->"Quality",AxesLabel-> {z[t],z[t+tau],z[t+2 tau]}]}],
{{tmax,60,"Time t"},5,100,ImageSize->Large,Appearance->"Labeled"},
{{tau,0.1,"Delay τ"},0,1.0,ImageSize->Large,Appearance->"Labeled"},
SaveDefinitions->True,TrackedSymbols:>{tmax,tau}]

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