Duffing-Oszillator (Erweiterung des harmonischen Oszillators)

<<EquationTrekker`

EquationTrekker[{ x''[t]+ γ x'[ t] - x[t] + x[t]^3 == ϵ Cos[t]}, {x,x'}, {t,0, 100},
PlotRange->{{-2,2},{-2,2}},
TrekParameters->{γ->0.15, ϵ->.3}]

Poincaré-Schnitt für Duffing-Oszillator

data = Block[{γ=0.15,ϵ=0.3},Reap[NDSolve[{x''[t]+γ x'[t]-x[t]+x[t]^3==ϵ Cos[ t],x[0]==0,x'[0]==0,WhenEvent[Mod[t,2π]==0,Sow[{x[t],x'[t]}]]},{},{t,0,100000},MaxSteps->∞]]][[-1,1]];

ListPlot[data,ImageSize->Large,PlotRange->{{-1.5,1.5},All},PlotStyle->PointSize[0.0025]]

Rössler-Attraktor

k=NDSolve[{x'[t]==-(y[t]+z[t]),y'[t]==x[t]+0.2*y[t],z'[t]==0.2+x[t]*z[t]-5.7*z[t],x[0]==0,y[0]==0,z[0]==0},{x,y,z},{t,0,10000}]

ParametricPlot3D[Evaluate[{x[t],y[t],z[t]}/.k],{t,0,700},PlotRange->{{-10,12},{-12,9},{0,25}},AxesLabel->{x,y,z}]

Poincaré-Schnitt  des Rösslerattraktors:

Clear[data1]

data1=Block[{a=0.2,b=0.2,c=5.7},Reap[NDSolve[{x'[t]==-(y[t]+z[t]),y'[t]==x[t]+a*y[t],z'[t]==b+x[t]*z[t]-c*z[t],x[0]==0,y[0]==0,z[0]==0,WhenEvent[y[t]==1,Sow[{x[t],z[t]}]]},{},{t,0,10000},MaxSteps->∞]]][[-1,1]];
ListPlot[data1,ImageSize->Large,PlotStyle->PointSize[0.005],AxesLabel->{x,z}]

Lorenz-Attraktor:

Clear[leqns,pl]

leqns = {x'[t]==-σ*(x[t]-y[t]),y'[t]==-x[t] z[t]+τ x[t]-y[t],z'[t]==x[t] y[t]-υ*z[t]};

pl = ParametricNDSolveValue[{leqns,x[0]==1,z[0]==30,y[0]==1},Function[Evaluate[{x[#],y[#],z[#]}]],{t,0,60},{σ,τ,υ}];

ParametricPlot3D[pl[10,28,(8/3)][t],{t,0,50},AxesLabel->{x,y,z}]

Poincaré-Schnitt z=20 für Lorenzattraktor:

Clear[data2]

data2=Block[{σ=10,τ=20,υ=(8/3)},Reap[NDSolve[{x'[t]==-σ*(x[t]-y[t]),y'[t]==-x[t] z[t]+τ x[t]-y[t],z'[t]==x[t] y[t]-υ*z[t],x[0]==1,y[0]==1,z[0]==30,WhenEvent[z[t]==20,Sow[{x[t],y[t]}]]},{},{t,0,45},MaxSteps->∞]]][[-1,1]];

ListPlot[data2,ImageSize->Large,PlotStyle->PointSize[0.005],PlotRange->{{-15,15},{-24,22}},AxesLabel->{x,y}]

EquationTrekker[{ x''[t] + γ x'[ t] - x[t] + x[t]^3 == ϵ Cos[ω t]}, x, {t,0, 1000},
PlotRange->{{-2,2},{-2,2}},
TrekParameters->{γ->0.009, ϵ->.3, ω->1.}, TrekGenerator->{PoincareSection, "SectionCondition"->Mod[ω t, 2 π], "SectionVariables"->{x, x'},MaxSteps->∞}]

μ=0.3;

0.3`

s=NDSolve[{x'[t]==-y[t]+x[t](μ-(x[t]^2+y[t]^2)),y'[t]==x[t]+y[t](μ-(x[t]^2+y[t]^2)),x[0]==y[0]==1},{x,y},{t,0,100}]

ParametricPlot[Evaluate[{x[t],y[t]}/.s],{t,0,100}]

s=NDSolve[{x'[t]==-y[t]-x[t]^2,y'[t]==2x[t]-y[t]^3,x[0]==y[0]==1},{x,y},{t,20}]

EquationTrekker[{x'[t]==-y[t]+x[t](α-(x[t]^2+y[t]^2)),y'[t]==x[t]+y[t](α-(x[t]^2+y[t]^2))}, {x,y}, {t,0, 100},
PlotRange->{{-2,2},{-2,2}},
TrekParameters->{α-> 0.3}]

<<EquationTrekker`

EquationTrekker[{x'[t]==-y[t]+x[t](α+(x[t]^2+y[t]^2)-(x[t]^2+y[t]^2)^2),y'[t]==x[t]+y[t](α+(x[t]^2+y[t]^2)-(x[t]^2+y[t]^2)^2)}, {x,y}, {t,0, 100},
PlotRange->{{-2,2},{-2,2}},
TrekParameters->{α-> 0}]

EquationTrekker[{x'[t]==-y[t]+x[t](α+(x[t]^2+y[t]^2)-(x[t]^2+y[t]^2)^2),y'[t]==x[t]+y[t](α+(x[t]^2+y[t]^2)-(x[t]^2+y[t]^2)^2)}, {x,y}, {t,0, 1000},
PlotRange->{{-2,2},{-2,2}},
TrekParameters->{α-> -0.25}]