Bifurcation

Saddle-node bifurcation

Clear[r,x]
Manipulate[
pts=Quiet[Solve[y==0&&y==r+x^2,{x,y}]];
p1=Plot[r+x^2,{x,-3,3},PlotRange->{-2,6},AxesLabel->{"x","(∂_t)x"},LabelStyle->20,PlotLabel-> Style["Phase portrait (saddle-node)",17]];
If[r≤0,
Show[p1,Graphics[{PointSize[Large],Red,Point[{x,y}/.pts]}]],
p1],
Control[{{r,0,"Control parameter, r"},-2,2,Appearance->"Labeled"}],TrackedSymbols:>{r},SaveDefinitions->True]

Clear[roots,x,r]
roots=Solve[r+x^2==0,x]
Plot[x/.roots,{r,-2,1},AxesLabel->{"r","(SuperStar[x])"},PlotLabel-> Style["Bifurcation diagram (saddle-node)",17],LabelStyle->20]

Not so clear example (analytics) of saddle-node bifurcation

Clear[roots,x,r]
roots=Solve[r+x - Log[1+x]==0,x](*impossible to take algebraically (inverse func)*)
Plot[x/.roots,{r,-2,1},AxesLabel->{r,"(SuperStar[x])"},PlotLabel-> "Bifurcation diagram (saddle-node)",LabelStyle->18]
(*you could use the ProductLog function to plot the entire diagram*)

Not so clear example (graphical solution)

Clear[r,x,y]
Manipulate[
y1=r+x;
y2=Log[1+x];
pts=Quiet[Solve[y==y1&&y==y2,{x,y}]];
p1=Plot[{y1,y2},{x,-2,5},PlotRange->{-3,4},AxesLabel->{x,y},LabelStyle->17];
If[r≤0,
Show[p1,Graphics[{PointSize[Large],Red,Point[{x,y}/.pts]}]],
p1],
Control[{{r,3,"Control parameter, r"},3,-2,Appearance->"Labeled"}],TrackedSymbols:>{r},SaveDefinitions->True]

Not so clear example (phase portrait)

Clear[r,x,y]
Manipulate[
pts=Quiet[Solve[y==0&&y==r+x-Log[1+x],{x,y}]];
plot=Plot[r+x-Log[1+x],{x,-2,5},AxesLabel->{"x","(∂_t)x"},LabelStyle->17,PlotRange->{-2,3}];
If[r≤0,
Show[plot,Graphics[{PointSize[Large],Red,Point[{x,y}/.pts]}]],
plot],
Control[{{r,-1,"Control parameter, r"},-2,2,Appearance->"Labeled"}],TrackedSymbols:>{r},SaveDefinitions->True]

Not so clear example (bifurcation diagram)

Clear[x,r]
Reduce[r+x==Log[1+x],x,Reals]

xr[r_]:=-1-ProductLog[{0,-1},-Exp[-1+r]](*0 corresponds to neg. branch, and -1 to positive*)
Plot[xr[r],{r,-2,0},FrameLabel->{r,"(SuperStar[x])"},Frame->True,LabelStyle->17]

Plot[{-1-ProductLog[0,-Exp[-1+r]],-1-ProductLog[-1,-Exp[-1+r]]},{r,-2,0},FrameLabel->{r,"(SuperStar[x])"},Frame->True,LabelStyle->17,PlotStyle->{{Black, Thickness[0.01]},{Black,Dashed}}](*stable and unstable branches manually*)

Transcritical bifurcation

Clear[r,x,y]
Manipulate[
pts=Quiet[Solve[y==0&&y==x r-x^2,{x,y}]];
p1=Plot[x r-x^2,{x,-3,3},PlotRange->{-5,2},AxesLabel->{"x","(∂_t)x"},LabelStyle->20,PlotLabel-> Style["Phase portrait (transcritical)",17]];
Show[p1,Graphics[{PointSize[Large],Red,Point[{x,y}/.pts]}]],
Control[{{r,0,"Control parameter, r"},-2,2,Appearance->"Labeled"}],TrackedSymbols:>{r},SaveDefinitions->True]

Clear[roots,x,r]
roots=Solve[x (r-x)==0,x]
Plot[x/.roots,{r,-2,2},AxesLabel->{r,"(SuperStar[x])"},PlotLabel-> Style["Bifurcation diagram (transcritical)",20],LabelStyle->20]

Pitchfork bifurcation (supercritical)

Clear[r,x,y]
Manipulate[
pts=Quiet[Solve[y==0&&y==x r-x^3,{x,y}]];
p1=Plot[x r-x^3,{x,-3,3},PlotRange->{-2,6},AxesLabel->{"x","(∂_t)x"},LabelStyle->20,PlotLabel-> Style["Phase portrait (supercritical pitchfork)",17]];
If[r≥0,
Show[p1,Graphics[{PointSize[Large],Red,Point[{x,y}/.pts]}]],
Show[p1,Graphics[{PointSize[Large],Red,Point[{0,0}]}]]],
Control[{{r,0,"Control parameter, r"},-3,3,Appearance->"Labeled"}],TrackedSymbols:>{r},SaveDefinitions->True]

Clear[roots,x,r]
roots=Solve[r x-x^3==0,x]
Plot[x/.roots,{r,-2,2},AxesLabel->{r,"(SuperStar[x])"},PlotLabel-> Style["Bifurcation diagram (pitchfork bifurcation)",18],LabelStyle->20]

Pitchfork bifurcation (subcritical)

Clear[r,x,y]
Manipulate[
pts=Quiet[Solve[y==0&&y==x r+x^3,{x,y}]];
p1=Plot[x r+x^3,{x,-3,3},PlotRange->{-2,6},AxesLabel->{"x","(∂_t)x"},LabelStyle->20,PlotLabel-> Style["Phase portrait (subcritical pitchfork)",17]];
If[r≤0,
Show[p1,Graphics[{PointSize[Large],Red,Point[{x,y}/.pts]}]],
Show[p1,Graphics[{PointSize[Large],Red,Point[{0,0}]}]]],
Control[{{r,0,"Control parameter, r"},-3,3,Appearance->"Labeled"}],TrackedSymbols:>{r},SaveDefinitions->True]

Clear[roots,x,r]
roots=Solve[r x+x^3==0,x]
Plot[x/.roots,{r,-2,2},AxesLabel->{r,"(SuperStar[x])"},PlotLabel-> Style["Bifurcation diagram (pitchfork bifurcation)",17],LabelStyle->20]

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