Bifurcations in 2-D systems: Saddle-Node coalescence of limit-cycles

Dynamics in radial direction, saddle-Node coalescence of limit-cycles

maxr=1.25;
Manipulate[
Plot[par r+r^3-r^5,{r,0,rmax},Epilog->{Red,AbsolutePointSize[10],Point[{r,0}/.Solve[par r+r^3-r^5==0&&r≥0,r,Reals]]},
ImageSize->Large,LabelStyle->Larger,AxesLabel->{"r","(∂_t)r"}],
{{rmax,0.9 maxr,"Radial r"},0.001,maxr,Appearance->"Labeled"},
{{par,-0.5,"Parameter μ"},-0.5,0.2,Appearance->"Labeled"},
 SaveDefinitions->True,TrackedSymbols:>{rmax,par}]

Case II, A: Saddle-Node coalescence of limit-cycles:

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

difr0=a0 r+r^3-r^5;
difr1=a1 r+r^3-r^5;
difr2=a2 r+r^3-r^5;
difr3=a3 r+r^3-r^5;
difr4=a4 r+r^3-r^5;
difθ=ω+b r^2;
cartesianfield0=TransformedField["Polar"->"Cartesian",{difr0,difθ},{r,θ}->{x,y}];
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}];
cartesianfield4=TransformedField["Polar"->"Cartesian",{difr4,difθ},{r,θ}->{x,y}];
fps=Graphics[{PointSize[0.03],Red,Point[{0,0}]}];
sp0=StreamPlot[cartesianfield0,{x,-1.6,1.6},{y,-1.6,1.6},FrameLabel->{x[t],y[t]},PlotLabel->"Case a < -1/4, stable spiral",ImageSize->imagesize,LabelStyle->Larger];
sp0t=StreamPlot[cartesianfield0,{x,-1.6,1.6},{y,-1.6,1.6},FrameLabel->{x[t],y[t]},PlotLabel->"Case a < -1/4, stable spiral",StreamPoints->{{1.3,0}},ImageSize->imagesize,LabelStyle->Larger,StreamColorFunction->None,StreamStyle->{Thick,Blue}];

sp1=StreamPlot[cartesianfield1,{x,-1.6,1.6},{y,-1.6,1.6},FrameLabel->{x[t],y[t]},PlotLabel->"Case a = -1/4, bif. p., coalescence, half-stable cycle",ImageSize->imagesize,LabelStyle->Larger];
sp1t=StreamPlot[cartesianfield1,{x,-1.6,1.6},{y,-1.6,1.6},FrameLabel->{x[t],y[t]},PlotLabel->"Case a = -1/4, bif. p., coalescence, half-stable cycle",StreamPoints->{{1.3,0}},ImageSize->imagesize,LabelStyle->Larger,StreamColorFunction->None,StreamStyle->{Thick,Blue}];

sp2=StreamPlot[cartesianfield2,{x,-1.6,1.6},{y,-1.6,1.6},FrameLabel->{x[t],y[t]},PlotLabel->"Case -1/4 < a < 0, unstable and stable cycles",ImageSize->imagesize,LabelStyle->Larger];
sp2t=StreamPlot[cartesianfield2,{x,-1.6,1.6},{y,-1.6,1.6},FrameLabel->{x[t],y[t]},PlotLabel->"Case -1/4 < a < 0, unstable and stable cycles",StreamPoints->{{0.87,0}},ImageSize->imagesize,LabelStyle->Larger,StreamColorFunction->None,StreamStyle->{Thick,Blue}];
sp2t2=StreamPlot[cartesianfield2,{x,-1.6,1.6},{y,-1.6,1.6},FrameLabel->{x[t],y[t]},PlotLabel->"Case -1/4 < a < 0, unstable and stable cycles",StreamPoints->{{0.35,0}},ImageSize->imagesize,LabelStyle->Larger,StreamColorFunction->None,StreamStyle->{Thick,Red}];

sp3=StreamPlot[cartesianfield3,{x,-1.6,1.6},{y,-1.6,1.6},FrameLabel->{x[t],y[t]},PlotLabel->"Case a = 0, subcritica Hopf bif. point (ignore cycle)",ImageSize->imagesize,LabelStyle->Larger];
sp3t=StreamPlot[cartesianfield3,{x,-1.6,1.6},{y,-1.6,1.6},FrameLabel->{x[t],y[t]},PlotLabel->"Case a = 0, subcritica Hopf bif. point (ignore cycle)",StreamPoints->{{1,0}},ImageSize->imagesize,LabelStyle->Larger,StreamColorFunction->None,StreamStyle->{Thick,Blue}];

sp4=StreamPlot[cartesianfield4,{x,-1.6,1.6},{y,-1.6,1.6},FrameLabel->{x[t],y[t]},PlotLabel->"Case a > 0, high amplitude stable cycle",ImageSize->imagesize,LabelStyle->Larger];
sp4t=StreamPlot[cartesianfield4,{x,-1.6,1.6},{y,-1.6,1.6},FrameLabel->{x[t],y[t]},PlotLabel->"Case a > 0, high amplitude stable cycle",StreamPoints->{{1,0}},ImageSize->imagesize,LabelStyle->Larger,StreamColorFunction->None,StreamStyle->{Thick,Blue}];

Row[{Show[sp0,sp0t,fps],Show[sp1,sp1t,fps],Show[sp2,sp2t,sp2t2,fps],Show[sp3,sp3t,fps],Show[sp4,sp4t,fps]}]

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

Bifurcation diagram

Clear[a]
bifsol=Solve[a r+r^3-r^5==0,r]
text1=Graphics[Text[Style["Unstable l.-c.",Large, Red],{-0.13,0.5},Automatic,{1,-0.9}]];
text2=Graphics[Text[Style["Stable spiral",Large],{-0.2,0.07}]];
text3=Graphics[Text[Style["Unstable spiral",Large,Red],{0.21,0.07}]];
text4=Graphics[Text[Style["Stable l.-c.",Large],{0.14,1.12},Automatic,{1,0.16}]];
bifplot=Plot[Evaluate[r/.bifsol],{a,-0.4,0.4},AxesLabel->{" μ","(SuperStar[r])"},PlotRange->{{-0.4,0.4},{0,1.2}},ImageSize->500,LabelStyle->19,PlotStyle->{Thick,Thick,{Dashed,Thick}}];
Show[bifplot,text1,text2,text3,text4](*Bifurcation diagram r^* as function of a*)

Integrated solution

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

Manipulate[
diffX=((x (Sqrt[(x^2)+(y^2)]) (a+(x^2)+(y^2)-((((x^2)+(y^2)))^2))-y (b ((x^2)+(y^2))+ω))/(Sqrt[(x^2)+(y^2)]));
diffY=((y (Sqrt[(x^2)+(y^2)]) (a+(x^2)+(y^2)-((((x^2)+(y^2)))^2))+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.25,"Parameter a"},-0.4,1,Appearance->"Labeled"},{{point,{1.0,0.5}},Locator}, SaveDefinitions->True,TrackedSymbols:>{T,parameter,point}]

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