Das Haken-Zwanzig Modell

Definition des Differentialgleichungssystems als Funktion

ODE[e_,g_]:={u'[t]==e u[t] - u[t] s[t],s'[t]==-g s[t]+u[t]^2}

Lösung des Systems wird durch NDSolve gegeben

ODEsol[e_,g_,x0_,y0_]:=NDSolve[{ODE[e,g],u[0]==x0,s[0]==y0},{u[t],s[t]},{t,0,100}]

Die Trajektorie wird als parametrischer Plot der Lösung definiert

ODETrajectory[e_,g_,x0_,y0_]:=ParametricPlot[Evaluate[{u[t],s[t]}/.ODEsol[e,g,x0,y0]],{t,0,100},PlotRange->{{-.5,.5},{-.5,.5}},Axes->False,Frame ->True]

Die Zeitreihe der x- und y-Komponenten wird als normaler Plot definiert

ODETimeSeries[e_,g_,x0_,y0_]:=Plot[Evaluate[{u[t],s[t]}/.ODEsol[e,g,x0,y0]],{t,0,100},PlotRange->All,Axes->False,Frame ->True]

Darstellung mehrerer Trajektorien in Abhängigkeit von ϵ  / γ (hier g) = 1

Um die Trajektorien und die Zeitreihen in Abhängigkeit des Parameters g zu plotten, kann der Befehl Manipulate verwendet werden

Manipulate[Show[ODETrajectory[ϵ,1,-.2,-.5],ODETrajectory[ϵ,1,.2,.5],ODETrajectory[ϵ,1,.5,.1],ODETrajectory[ϵ,1,-.5,.1],ODETrajectory[ϵ,1,-.2,.5],ODETrajectory[ϵ,1,0.2,-.5],ODETrajectory[ϵ,1,-.002,0],ODETrajectory[ϵ,1,.002,0]],{ϵ,-.75,.5}]

Darstellung einer Trajektorie in Abhängigkeit von ϵ  / γ (hier g) = 1

Manipulate[Show[ODETimeSeries[ϵ,1,-.05,-0.5],Plot[{0,-N[Sqrt[ϵ]],ϵ},{x,0,100}]],{ϵ,-.2,0,0.01}]

Darstellung der Näherung s = S(u) an die zentrale Mannigfaltigkeit zusammen mit den Fixpunkten

FPY[ϵ_]:=Piecewise[{{0,ϵ≤0},{Sqrt[ϵ],v≥0}}]

FPX[ϵ_]:=Piecewise[{{0,ϵ≤0},{ϵ,ϵ≥0}}]

Manipulate[Show[ODETrajectory[ϵ,1,-.2,-.5],ODETrajectory[ϵ,1,.2,.5],ODETrajectory[ϵ,1,.5,.1],ODETrajectory[ϵ,1,-.5,.1],ODETrajectory[ϵ,1,-.2,.5],ODETrajectory[ϵ,1,0.2,-.5],ODETrajectory[ϵ,1,-.002,0],ODETrajectory[ϵ,1,.002,0],Plot[{x^2,x^2+2*x^4,x^2+2*x^4+12*x^6,0},{x,-0.5,0.5}],FrameLabel->{"u","s"},RotateLabel->False,Epilog->{PointSize[.02],Point[{0,0}],Point[{FPY[ϵ],FPX[ϵ]}],Point[{-FPY[ϵ],FPX[ϵ]}]}],{ϵ,-0.1,0.1}]

Reihendarstellung von s = S(u)

eq[k_]:=(∑_(m=0)^k)(∑_(l=0)^k)2 l (Subscript[S, (2m)])(Subscript[S, (2l)])KroneckerDelta[k,m+l]==g (Subscript[S, 2 k])/. {(Subscript[S, 2])->1/g,(Subscript[S, 0])->0}

l=Flatten[Table[Solve[eq[n],(Subscript[S, 2n])],{n,2,6}]]

m=2;

neu=l[[m]];

For[n=m,n>1,n--,{neu=neu/.l[[n-1]],Print[neu]}]

Darstellung der Eigenwerte bei Änderung  von ϵ

Manipulate[Plot[0,{x,-1.5,1.5},Epilog->{PointSize[.02],Point[{ϵ,0}],Point[{-1,0}]}],{ϵ,-.5,.5}]