Bifurcations in 2-D systems: SNIPER

Dynamics in radial direction and in the direction of θ, SNIPER

Plot[r (1-r^2),{r,0,1.2},ImageSize->Large,LabelStyle->18,AxesLabel->{"r","(∂_t)r"},Epilog->{Red,AbsolutePointSize[10],Point[{r,0}/.Solve[r (1-r^2)==0&&r≥0,r,Reals]]}]

maxθ=6 Pi;
Manipulate[
If[par<1,
Plot[par-Sin[θ],{θ,0,maxθ},Epilog->{Red,AbsolutePointSize[10],Point[{θ,0}/.Quiet[Solve[par-Sin[θ]==0&&0≤θ≤maxθ,θ,Reals]]]},
ImageSize->Large,LabelStyle->18,AxesLabel->{"θ","(∂_t)θ"},PlotRange->{-1.2,2.5}],
Plot[par-Sin[θ],{θ,0,maxθ},ImageSize->Large,LabelStyle->18,AxesLabel->{"θ","(∂_t)θ"},PlotRange->{-1.2,2.5}]],
{{par,1.5,"Parameter ω"},1.5,-0.2,Appearance->"Labeled"},
 SaveDefinitions->True,TrackedSymbols:>par]

Case II, B: SNIPER (Saddle-Node infinite period bifurcation):

Clear[r,θ,ω]
imagesize=310;
ω1=1.2;
ω2=1;
ω3=0.8;

difr=r (1-r^2);
difθ1=ω1-Sin[θ];
difθ2=ω2-Sin[θ];
difθ3=ω3-Sin[θ];

fp1={0,0};
fp2={{0,0},CoordinateTransform[ "Polar" -> "Cartesian",{1,ArcSin[ω2]}]};
fp3={{0,0},CoordinateTransform[ "Polar" -> "Cartesian",{1,ArcSin[ω3]}], {-1,1}*CoordinateTransform[ "Polar" -> "Cartesian",{1,ArcSin[ω3]}]};
pfp1=Graphics[{PointSize[0.03],Red,Point[fp1]}];
pfp2=Graphics[{PointSize[0.03],Red,Point[fp2]}];
pfp3=Graphics[{PointSize[0.03],Red,Point[fp3]}];
cartesianfield1=TransformedField["Polar"->"Cartesian",{difr,difθ1},{r,θ}->{x,y}];
cartesianfield2=TransformedField["Polar"->"Cartesian",{difr,difθ2},{r,θ}->{x,y}];
cartesianfield3=TransformedField["Polar"->"Cartesian",{difr,difθ3},{r,θ}->{x,y}];
sp1=StreamPlot[cartesianfield1,{x,-1.4,1.4},{y,-1.4,1.4},FrameLabel->{x[t],y[t]},PlotLabel->Style["Case ω > 1",Large],ImageSize->imagesize,LabelStyle->Larger];
sp1t=StreamPlot[cartesianfield1,{x,-1.4,1.4},{y,-1.4,1.4},FrameLabel->{x[t],y[t]},PlotLabel->Style["Case ω > 1",Large],StreamPoints->{{1.3,0}},ImageSize->imagesize,LabelStyle->Larger,StreamColorFunction->None,StreamStyle->{Thick,Blue}];

sp2=StreamPlot[cartesianfield2,{x,-1.4,1.4},{y,-1.4,1.4},FrameLabel->{x[t],y[t]},PlotLabel->Style["Case ω = 1, bif. point",Large],ImageSize->imagesize,LabelStyle->Larger];
sp2t=StreamPlot[cartesianfield2,{x,-1.4,1.4},{y,-1.4,1.4},FrameLabel->{x[t],y[t]},PlotLabel->Style["Case ω = 1, bif. point",Large],StreamPoints->{{1,0}},ImageSize->imagesize,LabelStyle->Larger,StreamColorFunction->None,StreamStyle->{Thick,Blue}];

sp3=StreamPlot[cartesianfield3,{x,-1.4,1.4},{y,-1.4,1.4},FrameLabel->{x[t],y[t]},PlotLabel->Style["Case ω < 1",Large],ImageSize->imagesize,LabelStyle->Larger];
sp3t=StreamPlot[cartesianfield3,{x,-1.4,1.4},{y,-1.4,1.4},FrameLabel->{x[t],y[t]},PlotLabel->Style["Case ω < 1",Large],StreamPoints->{{1,0}},ImageSize->imagesize,LabelStyle->Larger,StreamColorFunction->None,StreamStyle->{Thick,Blue}];

Row[{Show[sp1,sp1t,pfp1],Show[sp2,sp2t,pfp2],Show[sp3,sp3t,pfp3]}]

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

Integrated solution

Clear[diffX,diffY,x,y,a,ω,b]
imagesize=350;domx=1.5;domy=1.5;maxT=27;

Manipulate[
diffX=x-(x^3)-x (y^2)+y ((y/((x^2)+(y^2)))-(ω/(Sqrt[(x^2)+(y^2)])));
diffY=y-(x^2) y-(y^3)-((x y)/((x^2)+(y^2)))+((x ω)/(Sqrt[(x^2)+(y^2)]));
difX=diffX/.{x->x[t],y->y[t]};difY=diffY/.{x->x[t],y->y[t]};
splot=StreamDensityPlot[{diffX/.ω->parameter,diffY/.ω->parameter},{x,-domx,domx},{y,-domy,domy},FrameLabel->{x[t],y[t]},ImageSize->imagesize,LabelStyle->17,ColorFunction->"Pastel"];
fp=If[parameter>1,{0,0},{{0,0},CoordinateTransform[ "Polar" -> "Cartesian",{1,ArcSin[parameter]}],{-1,1}*CoordinateTransform[ "Polar" -> "Cartesian",{1,ArcSin[parameter]}]}];
pfp=Graphics[{PointSize[0.03],Red,Point[fp]}];
integration=NDSolve[{
x'[t]==difX/.ω->parameter,
y'[t]==difY/.ω->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->17,PlotStyle->Black];
soly=Plot[Evaluate[y[t]/.integration],{t,0,T},PlotRange-> All,AxesLabel-> {t,y[t]},ImageSize->imagesize,LabelStyle->17,PlotStyle->Black];
Grid[{{Show[splot,trajectory,pfp],soly},{solx}},Frame->All],
{{T,0.5 maxT,"Integration time, t"},1,maxT,Appearance->"Labeled"},
{{parameter,1,"Parameter ω"},0.0,1.8,Appearance->"Labeled"},
{{point,{0.2,-0.3}},Locator}, SaveDefinitions->True,TrackedSymbols:>{T,parameter,point}]

Example: ECG signal and taking poison

pilt=Import["Desktop/ecg.png"];

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

Clear[diffX,diffY,x,y,a,ω,b,k]
imagesize=350;domx=1.5;domy=1.5;maxT=6;maxk = 60;
Manipulate[
diffX=x-(x^3)-x (y^2)+y (-((k y)/((x^2)+(y^2)))-((k ω)/(Sqrt[(x^2)+(y^2)])));
diffY=y-(x^2) y-(y^3)+((k x y)/((x^2)+(y^2)))+((x ω k)/(Sqrt[(x^2)+(y^2)]));
difX=diffX/.{x->x[t],y->y[t]};difY=diffY/.{x->x[t],y->y[t]};
splot=StreamDensityPlot[{diffX/.ω->parameter,diffY/.ω->parameter},{x,-domx,domx},{y,-domy,domy},FrameLabel->{x[t],y[t]},ImageSize->imagesize,LabelStyle->17,ColorFunction->"Pastel"];
fp=If[parameter>1,{0,0},{{0,0},CoordinateTransform[ "Polar" -> "Cartesian",{1,ArcSin[-parameter]}],{-1,1}*CoordinateTransform[ "Polar" -> "Cartesian",{1,ArcSin[-parameter]}]}];
pfp=Graphics[{PointSize[0.03],Red,Point[fp]}];
integration=NDSolve[{
x'[t]==difX/.ω->parameter,
y'[t]==difY/.ω->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->17,PlotStyle->Black];
soly=Plot[Evaluate[y[t]/.integration],{t,0,T},PlotRange-> All,AxesLabel-> {t,y[t]},ImageSize->imagesize,LabelStyle->17,PlotStyle->Black];
Grid[{{Show[splot,trajectory,pfp],soly},{solx,Image[pilt,ImageSize->imagesize]}},Frame->All],
{{T,0.5 maxT,"Integration time, t"},1,maxT,Appearance->"Labeled"},
{{k,30,"Steepness, k"},1,maxk,Appearance->"Labeled"},
{{parameter,1.01,"Parameter ω"},0.81,1.21,Appearance->"Labeled"},
{{point,{0.6,-0.6}},Locator}, SaveDefinitions->True,TrackedSymbols:>{T,k,parameter,point}]

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