Bifurcations in 2-D systems

Static images and linear analysis, same as numerics7.nb file

Case I, A: Bifurcations of fixed points:

1) Saddle-node bifurcation (at λ = 0)

a1=-1;a2=0;a3=2;
imagesize=300;xdom=2;ydom=2;

diffx1=a1-x^2;
diffx2=a2-x^2;
diffx3=a3-x^2;
diffy=-y;
fps1=Solve[{diffx1==0,diffy==0},{x,y}];
fps2=Solve[{diffx2==0,diffy==0},{x,y}];
fps3=Solve[{diffx3==0,diffy==0},{x,y}];

Print[Style["Jacobian matrix, cases: a<0, a=0, a>0",18,Blue]]
matrix1={diffx1,diffy};
matrix2={diffx2,diffy};
matrix3={diffx3,diffy};
D[matrix1,{{x,y}}]//MatrixForm (*Jacobian*)
D[matrix2,{{x,y}}]//MatrixForm 
D[matrix3,{{x,y}}]//MatrixForm 
Jfp1=D[matrix1,{{x,y}}]/.fps1 ; 
Jfp2=D[matrix2,{{x,y}}]/.fps2 ;
Jfp3=D[matrix3,{{x,y}}]/.fps3 ; 
Print[Style["Jacobian matric about f.p.s, cases: a<0, a=0, a>0",18,Blue]]
Map[MatrixForm][Jfp1]
Map[MatrixForm][Jfp2]
Map[MatrixForm][Jfp3]
Print[Style["Determinants, cases: a<0, a=0, a>0",18,Blue]]
Map[Det][Jfp1]
Map[Det][Jfp2]
Map[Det][Jfp3]
Print[Style["Trace, cases: a<0, a=0, a>0",18,Blue]]
Map[Tr][Jfp1]
Map[Tr][Jfp2]
Map[Tr][Jfp3]
Print[Style["Eigenvalues, cases: a<0, a=0, a>0",18,Blue]]
Map[Eigenvalues][Jfp1]
Map[Eigenvalues][Jfp2]
Map[Eigenvalues][Jfp3]
Print[Style["Coordinates of f.p.s, cases: a<0, a=0, a>0",18,Blue]]
coordinates1={x,y}/.fps1
coordinates2={x,y}/.fps2
coordinates3={x,y}/.fps3
Gfps1=Graphics[{PointSize[0.03],Red,Point[coordinates1]}];
Gfps2=Graphics[{PointSize[0.03],Red,Point[coordinates2]}];
Gfps3=Graphics[{PointSize[0.03],Red,Point[coordinates3]}];
sp1=StreamDensityPlot[{diffx1,diffy},{x,-xdom,xdom},{y,-ydom,ydom},ColorFunction->"Pastel",FrameLabel->{x[t],y[t]},PlotLabel->Style["Case, a < 0",Large],ImageSize->imagesize,LabelStyle->Larger];
sp2=StreamDensityPlot[{diffx2,diffy},{x,-xdom,xdom},{y,-ydom,ydom},ColorFunction->"Pastel",FrameLabel->{x[t],y[t]},PlotLabel->Style["Case, a = 0, bif. point",Large],ImageSize->imagesize,LabelStyle->Larger];
sp3=StreamDensityPlot[{diffx3,diffy},{x,-xdom,xdom},{y,-ydom,ydom},ColorFunction->"Pastel",FrameLabel->{x[t],y[t]},PlotLabel->Style["Case, a > 0",Large],ImageSize->imagesize,LabelStyle->Larger];
Row[{Show[sp1],Show[sp2,Gfps2],Show[sp3,Gfps3]}](*not showing imaginary points*)

2) Transcritical bifurcation (λ = 0)

a1=-2;a2=0;a3=2;
imagesize=300;xdom=3;ydom=2;

diffx1=a1 x-x^2;
diffx2=a2 x-x^2;
diffx3=a3 x-x^2;
diffy=-y;
fps1=Solve[{diffx1==0,diffy==0},{x,y}];
fps2=Solve[{diffx2==0,diffy==0},{x,y}];
fps3=Solve[{diffx3==0,diffy==0},{x,y}];

Print[Style["Jacobian matrix, cases: a<0, a=0, a>0",18,Blue]]
matrix1={diffx1,diffy};
matrix2={diffx2,diffy};
matrix3={diffx3,diffy};
D[matrix1,{{x,y}}]//MatrixForm (*Jacobian*)
D[matrix2,{{x,y}}]//MatrixForm 
D[matrix3,{{x,y}}]//MatrixForm 
Jfp1=D[matrix1,{{x,y}}]/.fps1 ; 
Jfp2=D[matrix2,{{x,y}}]/.fps2 ;
Jfp3=D[matrix3,{{x,y}}]/.fps3 ; 
Print[Style["Jacobian matric about f.p.s, cases: a<0, a=0, a>0",18,Blue]]
Map[MatrixForm][Jfp1]
Map[MatrixForm][Jfp2]
Map[MatrixForm][Jfp3]
Print[Style["Determinants, cases: a<0, a=0, a>0",18,Blue]]
Map[Det][Jfp1]
Map[Det][Jfp2]
Map[Det][Jfp3]
Print[Style["Trace, cases: a<0, a=0, a>0",18,Blue]]
Map[Tr][Jfp1]
Map[Tr][Jfp2]
Map[Tr][Jfp3]
Print[Style["Eigenvalues, cases: a<0, a=0, a>0",18,Blue]]
Map[Eigenvalues][Jfp1]
Map[Eigenvalues][Jfp2]
Map[Eigenvalues][Jfp3]
Print[Style["Coordinates of f.p.s, cases: a<0, a=0, a>0",18,Blue]]
coordinates1={x,y}/.fps1
coordinates2={x,y}/.fps2
coordinates3={x,y}/.fps3
Gfps1=Graphics[{PointSize[0.03],Red,Point[coordinates1]}];
Gfps2=Graphics[{PointSize[0.03],Red,Point[coordinates2]}];
Gfps3=Graphics[{PointSize[0.03],Red,Point[coordinates3]}];
sp1=StreamDensityPlot[{diffx1,diffy},{x,-xdom,xdom},{y,-ydom,ydom},ColorFunction->"Pastel",FrameLabel->{x[t],y[t]},PlotLabel->Style["Case, a < 0",Large],ImageSize->imagesize,LabelStyle->Larger];
sp2=StreamDensityPlot[{diffx2,diffy},{x,-xdom,xdom},{y,-ydom,ydom},ColorFunction->"Pastel",FrameLabel->{x[t],y[t]},PlotLabel->Style["Case, a = 0, bif. point",Large],ImageSize->imagesize,LabelStyle->Larger];
sp3=StreamDensityPlot[{diffx3,diffy},{x,-xdom,xdom},{y,-ydom,ydom},ColorFunction->"Pastel",FrameLabel->{x[t],y[t]},PlotLabel->Style["Case, a > 0",Large],ImageSize->imagesize,LabelStyle->Larger];
Row[{Show[sp1,Gfps1],Show[sp2,Gfps2],Show[sp3,Gfps3]}]

3) Pitchfork bifurcation, supercritical (λ = 0)

a1=-2;a2=0;a3=2;
imagesize=300;xdom=2;ydom=2;

diffx1=a1 x-x^3;
diffx2=a2 x-x^3;
diffx3=a3 x-x^3;
diffy=-y;
fps1=Solve[{diffx1==0,diffy==0},{x,y}];
fps2=Solve[{diffx2==0,diffy==0},{x,y}];
fps3=Solve[{diffx3==0,diffy==0},{x,y}];

Print[Style["Jacobian matrix, cases: a<0, a=0, a>0",18,Blue]]
matrix1={diffx1,diffy};
matrix2={diffx2,diffy};
matrix3={diffx3,diffy};
D[matrix1,{{x,y}}]//MatrixForm (*Jacobian*)
D[matrix2,{{x,y}}]//MatrixForm 
D[matrix3,{{x,y}}]//MatrixForm 
Jfp1=D[matrix1,{{x,y}}]/.fps1 ; 
Jfp2=D[matrix2,{{x,y}}]/.fps2 ;
Jfp3=D[matrix3,{{x,y}}]/.fps3 ; 
Print[Style["Jacobian matric about f.p.s, cases: a<0, a=0, a>0",18,Blue]]
Map[MatrixForm][Jfp1]
Map[MatrixForm][Jfp2]
Map[MatrixForm][Jfp3]
Print[Style["Determinants, cases: a<0, a=0, a>0",18,Blue]]
Map[Det][Jfp1]
Map[Det][Jfp2]
Map[Det][Jfp3]
Print[Style["Trace, cases: a<0, a=0, a>0",18,Blue]]
Map[Tr][Jfp1]
Map[Tr][Jfp2]
Map[Tr][Jfp3]
Print[Style["Eigenvalues, cases: a<0, a=0, a>0",18,Blue]]
Map[Eigenvalues][Jfp1]
Map[Eigenvalues][Jfp2]
Map[Eigenvalues][Jfp3]
Print[Style["Coordinates of f.p.s, cases: a<0, a=0, a>0",18,Blue]]
coordinates1={x,y}/.fps1
coordinates2={x,y}/.fps2
coordinates3={x,y}/.fps3
Gfps1=Graphics[{PointSize[0.03],Red,Point[coordinates1[[1]] ]}];(*only real ones*)
Gfps2=Graphics[{PointSize[0.03],Red,Point[coordinates2]}];
Gfps3=Graphics[{PointSize[0.03],Red,Point[coordinates3]}];
sp1=StreamDensityPlot[{diffx1,diffy},{x,-xdom,xdom},{y,-ydom,ydom},ColorFunction->"Pastel",FrameLabel->{x[t],y[t]},PlotLabel->Style["Case, a < 0",Large],ImageSize->imagesize,LabelStyle->Larger];
sp2=StreamDensityPlot[{diffx2,diffy},{x,-xdom,xdom},{y,-ydom,ydom},ColorFunction->"Pastel",FrameLabel->{x[t],y[t]},PlotLabel->Style["Case, a = 0, bif. point",Large],ImageSize->imagesize,LabelStyle->Larger];
sp3=StreamDensityPlot[{diffx3,diffy},{x,-xdom,xdom},{y,-ydom,ydom},ColorFunction->"Pastel",FrameLabel->{x[t],y[t]},PlotLabel->Style["Case, a > 0",Large],ImageSize->imagesize,LabelStyle->Larger];
Row[{Show[sp1,Gfps1],Show[sp2,Gfps2],Show[sp3,Gfps3]}]

Pitchfork bifurcation, subcritical (λ = 0)

a1=-2;a2=0;a3=2;
imagesize=300;xdom=2;ydom=2;

diffx1=a1 x+x^3;
diffx2=a2 x+x^3;
diffx3=a3 x+x^3;
diffy=-y;
fps1=Solve[{diffx1==0,diffy==0},{x,y}];
fps2=Solve[{diffx2==0,diffy==0},{x,y}];
fps3=Solve[{diffx3==0,diffy==0},{x,y}];

Print[Style["Jacobian matrix, cases: a<0, a=0, a>0",18,Blue]]
matrix1={diffx1,diffy};
matrix2={diffx2,diffy};
matrix3={diffx3,diffy};
D[matrix1,{{x,y}}]//MatrixForm (*Jacobian*)
D[matrix2,{{x,y}}]//MatrixForm 
D[matrix3,{{x,y}}]//MatrixForm 
Jfp1=D[matrix1,{{x,y}}]/.fps1 ; 
Jfp2=D[matrix2,{{x,y}}]/.fps2 ;
Jfp3=D[matrix3,{{x,y}}]/.fps3 ; 
Print[Style["Jacobian matric about f.p.s, cases: a<0, a=0, a>0",18,Blue]]
Map[MatrixForm][Jfp1]
Map[MatrixForm][Jfp2]
Map[MatrixForm][Jfp3]
Print[Style["Determinants, cases: a<0, a=0, a>0",18,Blue]]
Map[Det][Jfp1]
Map[Det][Jfp2]
Map[Det][Jfp3]
Print[Style["Trace, cases: a<0, a=0, a>0",18,Blue]]
Map[Tr][Jfp1]
Map[Tr][Jfp2]
Map[Tr][Jfp3]
Print[Style["Eigenvalues, cases: a<0, a=0, a>0",18,Blue]]
Map[Eigenvalues][Jfp1]
Map[Eigenvalues][Jfp2]
Map[Eigenvalues][Jfp3]
Print[Style["Coordinates of f.p.s, cases: a<0, a=0, a>0",18,Blue]]
coordinates1={x,y}/.fps1
coordinates2={x,y}/.fps2
coordinates3={x,y}/.fps3
Gfps1=Graphics[{PointSize[0.03],Red,Point[coordinates1]}];
Gfps2=Graphics[{PointSize[0.03],Red,Point[coordinates2]}];
Gfps3=Graphics[{PointSize[0.03],Red,Point[coordinates3[[1]]]}];(*only real ones*)
sp1=StreamDensityPlot[{diffx1,diffy},{x,-xdom,xdom},{y,-ydom,ydom},ColorFunction->"Pastel",FrameLabel->{x[t],y[t]},PlotLabel->Style["Case, a < 0",Large],ImageSize->imagesize,LabelStyle->Larger];
sp2=StreamDensityPlot[{diffx2,diffy},{x,-xdom,xdom},{y,-ydom,ydom},ColorFunction->"Pastel",FrameLabel->{x[t],y[t]},PlotLabel->Style["Case, a = 0, bif. point",Large],ImageSize->imagesize,LabelStyle->Larger];
sp3=StreamDensityPlot[{diffx3,diffy},{x,-xdom,xdom},{y,-ydom,ydom},ColorFunction->"Pastel",FrameLabel->{x[t],y[t]},PlotLabel->Style["Case, a > 0",Large],ImageSize->imagesize,LabelStyle->Larger];
Row[{Show[sp1,Gfps1],Show[sp2,Gfps2],Show[sp3,Gfps3]}]

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