Exercises 3.1.a

For:

x
=r-cosh(x)
i) Sketch the different vector field types that appear when you vary
r
. We’re actually going to do this first the hard way, then the easier way.
​
Looking at the phase portrait for different values of
r
we get the following.
​
In[]:=
finsol[r_]:=Select[{-ArcCosh[r],ArcCosh[r]},Head[#]Real&];GraphicsGridPartitionShowPlot[#-Cosh[x],{x,-5,6},AxesLabelEvaluate[Style[#,14]&/@{"x","

x
"}],PlotLabel"r = "<>ToString[#]],Iffinsol[#]==={},ListPlot[{{10,10}}],IfMin[finsol[#]]<10,If#1,ShowGraphics[Circle[{0,0},0.2]],GraphicsDisk{0,0},0.2,
π
2
,
-π
2
,Show[{Graphics[Circle[{finsol[#][[1]],0},0.2]],Graphics[Disk[{finsol[#][[2]],0},0.2]]}],Show[{Graphics[Disk[{finsol[#][[1]],0},0.2]],Graphics[Circle[{finsol[#][[2]],0},0.2]]}],If[finsol[#]==={},Graphics[{Thick,Arrow[{{3,0},{-3,0}}]}],{Graphics[{Thick,Arrow[{{Min[finsol[#]]-0.2,0},{-3,0}}],Arrow[{{Min[finsol[#]]+0.2,0},{Max[finsol[#]]-0.2,0}}],Arrow[{{3,0},{Max[finsol[#]]+0.2,0}}]}]}],PlotRange{{-3,3},{-3,3}},AspectRatio1&/@Range[0.5,3.5,0.5],3,ImageSize1200,Spacings{-10,0},FrameAll
Out[]=
​
Now taking the arrows and fixed points alone and plotting them as a vector field:
In[]:=
rv=Range[0.5,4.5,0.5]​​vfp=ShowShowIffinsol[#]==={},ListPlot[{{10,10}}],IfMin[finsol[#]]<10,If#1,ShowGraphics[Circle[{0,#},0.2]],GraphicsDisk{0,#},0.2,
π
2
,
-π
2
,Show[{Graphics[Circle[{finsol[#][[1]],#},0.2]],Graphics[Disk[{finsol[#][[2]],#},0.2]]}],Show[{Graphics[Disk[{finsol[#][[1]],#},0.2]],Graphics[Circle[{finsol[#][[2]],#},0.2]]}],If[finsol[#]==={},Graphics[{Thick,Red,Arrow[{{3,#},{-3,#}}]}],{Graphics[{Thick,Red,Arrow[{{Min[finsol[#]]-0.2,#},{-3,#}}],Arrow[{{Min[finsol[#]]+0.2,#},{Max[finsol[#]]-0.2,#}}],Arrow[{{3,#},{Max[finsol[#]]+0.2,#}}]}]}],AspectRatio1&/@rv,PlotRange{{-3,3},{0,5}},AspectRatio1,AxesLabelEvaluate[Style[#,14]&/@{"x","r"}],AxesTrue
Out[]=
{0.5,1.,1.5,2.,2.5,3.,3.5,4.,4.5}
Out[]=
We get the bifurcation diagram by rotating this whole plot above:
In[]:=
Show[vfp/.Arrow[{{a_,b_},{c_,d_}}]Arrow[{{b,a},{d,c}}]/.Circle[{a_,b_},c_]Circle[{b,a},c]/.Disk[{a_,b_},c__]Disk[{b,a},c],PlotRange{{0,5},{-3,3}}]/.{"x""r","r""x"}
Out[]=
We can actually find these fixed points and thus the bifurcation diagram more simply. We need to solve

x
=r-cosh(x)=0.
So the fixed points occur at:
In[]:=
{xArcCosh[r],x-ArcCosh[r]}
Out[]=
{xArcCosh[r],x-ArcCosh[r]}
We can plot these fixed points and this gives us
In[]:=
{{xArcCosh[r]},{x-ArcCosh[r]}}​​Plot[Evaluate[x/.%],{r,-6,6},AxesLabelEvaluate[Style[#,16]&/@{"r","x"}],PlotRange{{-1,5},{-3,3}},AspectRatio1,PlotStyleBlue]
Out[]=
{{xArcCosh[r]},{x-ArcCosh[r]}}
Out[]=
We actually already have whether the fixed points are stable or unstable from the vector field plot above, so let’s put these on:
In[]:=
{{xArcCosh[r]},{x-ArcCosh[r]}}​​Plot[Evaluate[x/.%],{r,-6,6},AxesLabelEvaluate[Style[#,16]&/@{"r","x"}],PlotRange{{-1,5},{-3,3}},AspectRatio1,PlotStyle{Blue,{Blue,Dashed}}]
The critical point is when the two solutions are the same (when we go from no fixed points, to one, to two):
Homepage