Bifurcations in 2-D systems:  Supercritical Hopf bifurcation

Dynamics in radial direction, supercritical Hopf bifurcation

Manipulate[
mxr=1.0;
Plot[par r-r^3,{r,0,rmax},Epilog->{Red,AbsolutePointSize[10],Point[{r,0}/.Solve[par r-r^3==0&&r≥0,r,Reals]]},
ImageSize->Large,LabelStyle->Larger,AxesLabel->{"r","(∂_t)r"}],
{{rmax,0.5 mxr,"Radial r"},0.001,mxr,Appearance->"Labeled"},
{{par,-0.5,"Parameter a"},-0.5,0.5,Appearance->"Labeled"},
 SaveDefinitions->False,TrackedSymbols:>{rmax,par}]

Case I, B: Hopf bifurcation:

1) Supercritical Hopf bifurcation

Clear[a,b,r,θ,ω]
imagesize=310;
a1=-1;a2=0;a3=1;
b=0.1;
ω=1;

difr1=a1 r-r^3;
difr2=a2 r-r^3;
difr3=a3 r-r^3;
difθ=ω+b r^2;
cartesianfield1=TransformedField["Polar"->"Cartesian",{difr1,difθ},{r,θ}->{x,y}];
cartesianfield2=TransformedField["Polar"->"Cartesian",{difr2,difθ},{r,θ}->{x,y}];
cartesianfield3=TransformedField["Polar"->"Cartesian",{difr3,difθ},{r,θ}->{x,y}];
fps=Graphics[{PointSize[0.03],Red,Point[{0,0}]}];
sp10=StreamPlot[cartesianfield1,{x,-1.3,1.3},{y,-1.3,1.3},FrameLabel->{x[t],y[t]},PlotLabel->Style["Case a < 0",Large],ImageSize->imagesize,LabelStyle->Larger];
sp1=StreamPlot[cartesianfield1,{x,-1.3,1.3},{y,-1.3,1.3},FrameLabel->{x[t],y[t]},PlotLabel->Style["Case a < 0",Large],StreamPoints->{{1.0,0}},ImageSize->imagesize,LabelStyle->Larger,StreamColorFunction->None,StreamStyle->{Thick,Blue}];
sp20=StreamPlot[cartesianfield2,{x,-1.3,1.3},{y,-1.3,1.3},FrameLabel->{x[t],y[t]},PlotLabel->Style["Case a = 0, bif. point",Large],ImageSize->imagesize,LabelStyle->Larger];
sp2=StreamPlot[cartesianfield2,{x,-1.3,1.3},{y,-1.3,1.3},FrameLabel->{x[t],y[t]},PlotLabel->Style["Case a = 0, bif. point",Large],StreamPoints->{{0.3,0}},ImageSize->imagesize,LabelStyle->Larger,StreamColorFunction->None,StreamStyle->{Thick,Blue}];
sp30=StreamPlot[cartesianfield3,{x,-1.3,1.3},{y,-1.3,1.3},FrameLabel->{x[t],y[t]},PlotLabel->Style["Case a > 0",Large],ImageSize->imagesize,LabelStyle->Larger];
sp3=StreamPlot[cartesianfield3,{x,-1.3,1.3},{y,-1.3,1.3},FrameLabel->{x[t],y[t]},PlotLabel->Style["Case a > 0",Large],StreamPoints->{{1.0,0}},ImageSize->imagesize,LabelStyle->Larger,StreamColorFunction->None,StreamStyle->{Thick,Blue}];
Row[{Show[sp10,sp1,fps],Show[sp20,sp2,fps],Show[sp30,sp3,fps]}]

(*used below for integrated num solution plot*)
Clear[a,b,r,θ,ω]
difr=a r-r^3;
difθ=ω+b r^2;
polarvectorfield={difr,difθ};
cartesianfield=TransformedField["Polar"->"Cartesian",polarvectorfield,{r,θ}->{x,y}];
FullSimplify[%]

(*Bifurcation diagram r^* as function of a*)
bifsol=Solve[difr==0,r]
text1=Graphics[Text[Style["Stable l.-c.",Large],{0.8,1.1},Automatic,{1,0.8}]];
text2=Graphics[Text[Style["Stable spiral",Large],{-0.8,0.1}]];
text3=Graphics[Text[Style["Unstable spiral",Large,Red],{1.1,0.1}]];
bifplot=Plot[Evaluate[r/.bifsol],{a,-1.5,2},AxesLabel->{"μ","(SuperStar[r])"},PlotRange->{{-1.5,2},{0,1.5}},LabelStyle->18,PlotStyle->{Thick,Thick,Thick}];
Show[bifplot,text1,text2,text3]

Integrated solution

Clear[diffX,diffY,x,y,a,ω,b,parameter]
imagesize=350;domx=1.4;domy=1.4;maxT=15;
b=0.1;
ω=1;

Manipulate[
diffX=a x-(x^3)-x (y^2)-((y (b ((x^2)+(y^2))+ω))/(Sqrt[(x^2)+(y^2)]));
diffY=a y-(x^2) y-(y^3)+((x (b ((x^2)+(y^2))+ω))/(Sqrt[(x^2)+(y^2)]));
difX=diffX/.{x->x[t],y->y[t]};difY=diffY/.{x->x[t],y->y[t]};
splot=StreamPlot[{diffX/.a-> parameter,diffY/.a-> parameter},{x,-domx,domx},{y,-domy,domy},FrameLabel->{x[t],y[t]},ImageSize->imagesize];
fixedp=Graphics[{PointSize[0.03],Red,Point[{0,0}]}];(*shit, avoiding singularity at 0,0*)
integration=NDSolve[{
x'[t]==difX/.a-> parameter,
y'[t]==difY/.a-> parameter,
x[0]==point[[1]],y[0]==point[[2]]},
{x,y},{t,0,T}];
trajectory=ParametricPlot[Evaluate[{x[t],y[t]}/.integration],{t,0,T},PlotStyle->Black];
solx=Plot[Evaluate[x[t]/.integration],{t,0,T},PlotRange-> All,AxesLabel-> {t,x[t]},ImageSize->imagesize,LabelStyle->16,PlotStyle->Black];
soly=Plot[Evaluate[y[t]/.integration],{t,0,T},PlotRange-> All,AxesLabel-> {t,y[t]},ImageSize->imagesize,LabelStyle->16,PlotStyle->Black];
Grid[{{Show[splot,trajectory,fixedp,LabelStyle->16],soly},{solx}},Frame->All],
{{T,0.5 maxT,"Integration time, t"},1,maxT,Appearance->"Labeled"},{{parameter,0.0,"Parameter a"},-1,1,Appearance->"Labeled"},{{point,{1,1}},Locator}, SaveDefinitions->True,TrackedSymbols:>{T,parameter,point}]

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