Bifurkationen 2- Simon Brennecke

Normalform mit speziellen Parametern

b1 = 1; ω1 = 1; 
Manipulate[feld1 = StreamPlot[{(b - (x^2 + y^2))*x - 
       (ω1 + b1*(x^2 + y^2))*y, (b - (x^2 + y^2))*y + 
       (ω1 + b1*(x^2 + y^2))*x}, {x, -2, 2}, {y, -2, 2}, 
     FrameLabel -> {Style["x", 16, Italic], Style["y", 16, Italic]}, 
     RotateLabel -> False, StreamStyle -> Directive[Opacity[0.8]], 
     StreamPoints -> 50]; Grenz1 = ParametricPlot[
     {Piecewise[{{Sqrt[b]*Cos[s], b >= 0}, {0, b < 0}}], 
      Piecewise[{{Sqrt[b]*Sin[s], b >= 0}, {0, b < 0}}]}, 
     {s, 0, 2*Pi}, PlotStyle -> Directive[Green, Thick, Opacity[0.99]]]; 
   Show[feld1, Grenz1], 
  Style["Beispiel: Superkritische Hopfbifurkation", 16, Italic], 
  Style["Parameter", 16, Italic], {{b,-5}, -5, 5,0.01,Appearance -> "Labeled"}]

Briggs-Rauscher-Reaktion aus der Präsentation.

Clear[x0];Clear[y0];Clear[a];Clear[b];
Manipulate[Module[{f1, f2, sol, x, y, t, b1, ww, verlauf, solSS}, x0 = 1.25; y0 = 1.25; f1[x_, y_] := a - x - (4*x*y)/(1 + x^2); 
    f2[x_, y_] := b*x*(1 - y/(1 + x^2)); solSS = Flatten[NSolve[{a - x - (4*x*y)/(1 + x^2) == 0, b*x*(1 - y/(1 + x^2)) == 0}, {x, y}]]; 
 sol = NDSolve[{Derivative[1][x][t] == a - x[t] - (4*x[t]*y[t])/(1 + x[t]^2), Derivative[1][y][t] == b*x[t]*(1 - y[t]/(1 + x[t]^2)), 
       x[0] == x0, y[0] == y0}, {x, y}, {t, 0, 1000}, Method -> "StiffnessSwitching"]; 
    verlauf = ParametricPlot[Evaluate[{x[t], y[t]} /. sol], {t, 500, 700}, PlotRange -> All, PlotStyle -> {Black, Thickness[0.01]}, 
      PlotPoints -> 1000]; ww = First[Cases[verlauf, x_Line :> First[x], Infinity]]; 
    Pane[Switch[ctrl, 1, Show[ContourPlot[{a - x - (4*x*y)/(1 + x^2) == 0, b*x*(1 - y/(1 + x^2)) == 0}, {x, 0, 7}, {y, 0, 23}, 
        FrameLabel -> {Style["x", 16, Italic], Style["y", 16, Italic]}, RotateLabel -> False, PlotPoints -> 100, 
        ContourStyle -> {{Black, Thick, Dashed, Opacity[0.99]}, {Black, Dashed, Thick, Opacity[0.99]}}, 
        Epilog -> {Red, PointSize[0.025], Point[{x, y} /. solSS]}], Graphics[{Green, Arrowheads[Table[0.01, {6}]], Dashed, Thickness[0.005], 
         Arrow[Line[Partition[ww, Floor[Length[ww/10]]][[1 ;; All ;; 100]]]]}], StreamPlot[{a - x - (4*x*y)/(1 + x^2), b*x*(1 - y/(1 + x^2))}, 
        {x, 0, 7}, {y, 0, 23}, StreamStyle -> Directive[Opacity[0.7]], StreamPoints -> 50], ImageSize -> 400*{1, 1}, 
       ImagePadding -> {{50, Automatic}, {Automatic, Automatic}}], 2, Plot[Evaluate[{x[t], y[t]} /. sol], {t, 550, 600}, PlotRange -> All, 
       PlotStyle -> {{Blue, Thick}, {Red, Thick}}, FrameLabel -> {Style["t", 16, Italic], 
         Style[Row[{Style["x", Italic], ", ", Style["y", 16, Italic]}], 16]}, RotateLabel -> False, Frame -> True, GridLines -> Automatic, 
       AspectRatio -> 1, PlotPoints -> 1000, ImageSize -> 400*{1, 1}, ImagePadding -> {{40, Automatic}, {40, Automatic}}, 
       PlotLegends -> {"x[t]", "y[t]"}]], ImageSize -> {400, 400}, Alignment -> Center]], 
  Style["Modell der Briggs-Rauscher-Reaktion", 16, Italic], Style["Parameter", 14, Italic], {{a, 13}, 6.5, 15, 0.01, Appearance -> "Labeled"}, 
  {{b, (3*a)/5 - 25/a}, 0.1, (3*a)/5 - 25/a + 3, 0.0001, Appearance -> "Labeled"}, 
  {{ctrl, 1, ""}, {1 -> "Phasenraum", 2 -> "Zeitentwicklung"}}, ControlPlacement -> Top]

Briggs - Rauscher - Reaktion mit variablen Startwerten und der Lösungstrajektorie im Phasenraum.

Manipulate[Module[{f1,f2,sol,x,y,t,b1,ww,verlauf,solSS},
f1[x_,y_]:=a-x-((4*x*y)/(1+(x^2)));
f2[x_,y_]:=b*x(1-(y/(1+(x^2))));
solSS=Flatten@NSolve[{a-x-((4*x*y)/(1+(x^2)))==0,b*x(1-(y/(1+(x^2))))==0},{x,y}];
sol=NDSolve[{x'[t]==a-x[t]-((4*x[t]*y[t])/(1+(((x[t]))^2))),y'[t]==b*x[t](1-((y[t])/(1+(((x[t]))^2)))),x[0]==x0,y[0]==y0},{x,y},{t,0,500},Method-> "StiffnessSwitching"];
verlauf=ParametricPlot[Evaluate[{x[t],y[t]}/.sol],{t,0,500},PlotRange->All,PlotStyle->{Black,Thickness[0.01]},PlotPoints->1000];
ww=First[Cases[verlauf,x_Line:> First@x,Infinity]];
Pane[Switch[ctrl,1,Show[ContourPlot[{a-x-((4*x*y)/(1+(x^2)))==0,b*x(1-(y/(1+(x^2))))==0},{x,0,7},{y,0,23},FrameLabel->{Style["x",16,Italic],Style["y",16,Italic]},RotateLabel->False,PlotPoints-> 100,ContourStyle->{{Black,Thick,Dashed,Opacity[0.99]},{Black,Dashed,Thick,Opacity[0.99]}},Epilog-> {Red,PointSize[0.025],Point[{x,y}/.solSS],Orange,Point[{x0,y0}]}],Graphics[{Green,Arrowheads[Table[0.06,{6}]],Dashed,Thickness[0.005],Arrow[Line[Partition[ww,Floor[Length[ww/10]]][[;;;;100]]]]}],
StreamPlot[{a-x-((4*x*y)/(1+(x^2))),b*x(1-(y/(1+(x^2))))},{x,0,7},{y,0,23},StreamStyle->Directive[Opacity[0.7]],StreamPoints-> 50],ImageSize->400{1,1},ImagePadding->{{50,Automatic},{Automatic,Automatic}}
],2,Plot[Evaluate[{x[t],y[t]}/.sol],{t,0,75},PlotRange->All,PlotStyle->{{Blue,Thick},{Red,Thick}},FrameLabel->{Style["t",16,Italic],Style[Row[{Style["x",Italic],", ",Style["y",16,Italic]}],16]},RotateLabel->False,Frame-> True,GridLines->Automatic,AspectRatio->1,PlotPoints->1000,ImageSize-> 400{1,1},ImagePadding->{{40,Automatic},{40,Automatic}},PlotLegends->{"x[t]","y[t]"}]],ImageSize->{550,400},Alignment->Center]],Style["Model der Briggs-Rauscher Reaktion",16,Italic],Style["Parameter",14,Italic],{{a,10},0.01,15,0.01,Appearance-> "Labeled"},
{{b,4.5},0.01,15,0.001,Appearance-> "Labeled"},Style["Anfangswerte",14,Italic],{{x0,1.25},Appearance-> "Labeled"},{{y0,1.25},Appearance-> "Labeled"},{{ctrl,1,""},{1-> "Phasenraum",2-> "Zeitentwicklung"}},ControlPlacement->Top]

Verhalten der Eigenwerte der Briggs-Rauscher-Reaktion

Off[Part::partd]
Manipulate[Module[{f1,f2,solSS,m1,m,x,y,t,b1,λ1,λ2,f1b1,f2b1,m2,sol,Eig},
f1[x_,y_]:=a-x-((4*x*y)/(1+(x^2)));
f2[x_,y_]:=b*x(1-(y/(1+(x^2))));

solSS=Flatten@NSolve[{a-x-((4*x*y)/(1+(x^2)))==0,b*x(1-(y/(1+(x^2))))==0},{x,y}];


m1=Outer[D,{f1[x,y],f2[x,y]},{x,y}];

m=m1/.solSS;

Eig=Chop@N@Eigenvalues[m];

f1b1[x_,y_]:=a-x-((4*x*y)/(1+(x^2)));
f2b1[x_,y_]:=b1*x(1-(y/(1+(x^2))));
sol=Flatten@Quiet@Solve[{a-x-((4*x*y)/(1+(x^2)))==0,b1*x(1-(y/(1+(x^2))))==0},{x,y}];
m2=Outer[D,{f1b1[x,y],f2b1[x,y]},{x,y}]/.sol;
{λ1,λ2}=Eigenvalues[m2];Show[ParametricPlot[{Re[λ1],Im[λ1]},{b1,0,45},PlotStyle->{{Red,Thick}},Frame->True,FrameLabel->{Style["Re(λ)",Italic,16],Style["Im(λ)",16]},RotateLabel->False,PlotRange->{{-3,2},{-7,7}},GridLines->Automatic,AspectRatio-> 1,PlotLabel->Style["Eigenwerte",Italic,16],PlotLegends->{"λ(b)^( * )"}],ParametricPlot[{Re[λ2],Im[λ2]},{b1,0,45},PlotStyle->{{Blue,Thick}},Frame->True,FrameLabel->{Style["Re(λ)",Italic,16],Style["Im(λ)",16]},RotateLabel->False,PlotRange->{{-3,2},{-7,7}},GridLines->Automatic,AspectRatio-> 1,PlotLegends->{"λ(b)"}],Graphics[{RGBColor[0,0.8,0],PointSize[0.025],Point[{Re[Eig[[1]]],Im[Eig[[1]]]}],Point[{Re[Eig[[2]]],Im[Eig[[2]]]}]},ImagePadding->{{40,Automatic},{40,Automatic}}],
ImageSize->.9 400{1,1}
]
]
,Style["Stabilität des Modells",Italic,16],Style["Parameter",14,Italic],
{{a,1},1,15,0.01,Appearance-> "Labeled"},{{b,1},1,15,0.01,Appearance-> "Labeled"},ControlPlacement->Top]