## Exercises 3.4.a

Exercises 3.4.a

For:=rx-ln(1+x)

x

i) Sketch the different vector field types that appear when you vary .

r

We’re going to do this a little differently from how we’ve done the others. To draw the vector field, you need to be able to draw whether is greater than or less than zero, which is the same as asking, in this case, whether . Let’s plot each of these for different values of

x

rxisgreaterthanorlessthanln(1+x)

randthendrawarrowsonthediagrams:

In[]:=

pl1=GraphicsGrid[Partition[Plot[{Log[1+x],#x},{x,-1,4},PlotRange->{{-1,4},{-4,2}},AxesLabelEvaluate[Style[#,14]&/@{"x","ln(1+x) and r x"}],AspectRatio->1,PlotLabel->Style["r = "<>ToString[#],14]]&/@Range[-0.5,2,0.5],3],ImageSize->800]

Out[]=

Nothing very interesting happens until To draw on the arrows, you just need to see whether is bigger. If is positive, and draw an arrow to the right. If it’s negative, draw an arrow to the left.

r≥1.

rxorln(1+x)

rxislarger,then

x

In[]:=

finsol[r_]:=(x/.NSolve[Log[1+x]-rx0,x])GraphicsGridPartitionShowPlot{Log[1+x],#x},{x,-1,4},PlotRange->{{-1,4},{-2,2}},AxesLabelEvaluateStyle[#,14]&/@"x","ln(x) and ",AspectRatio->1,PlotLabel->Style["r = "<>ToString[#],14],Graphics[{Thick,Arrowheads[0.05],Arrow[{{-1,0},{finsol[#][[1]]-0.1,0}}],If[#==1,,If[#>=0,Arrow[{{finsol[#+0.00001][[-1]]-0.1,0},{finsol[#][[1]]+0.1,0}}],]],Arrow[If[#<0,{{4,0},{finsol[#+0.00001][[-1]]+0.1,0}},{{finsol[#+0.00001][[-1]]+0.1,0},{4,0}}]]}],If#==1,ShowGraphics[Circle[{0,0},0.1]],GraphicsDisk{0,0},0.1,3,,Show[{Graphics[Disk[{finsol[#][[1]],0},0.1]],Graphics[Circle[{finsol[#+0.0001][[-1]],0},0.1]]}]&/@Range[-0.5,2,0.5],3,ImageSize->1000,Spacings->-30//Quiet

1-x

r

π

2

π

2

Out[]=

Now taking the arrows and fixed points alone and plotting them as a vector field:

In[]:=

ShowShowGraphics[{Thick,Arrowheads[0.04],Arrow[{{-1,#},{finsol[#][[1]]-0.01,#}}],If[#==1,,If[#>=0,Arrow[{{finsol[#+0.00001][[-1]]-0.1,#},{finsol[#][[1]]+0.1,#}}],]],Arrow[If[#<0,{{4,#},{finsol[#+0.00001][[-1]]+0.1,#}},{{finsol[#+0.00001][[-1]]+0.1,#},{4,#}}]]}],If#==1,ShowGraphics[Circle[{0,#},0.1]],GraphicsDisk{0,#},0.1,3,,Show[{Graphics[Disk[{finsol[#][[1]],#},0.1]],Graphics[Circle[{finsol[#+0.0001][[-1]],#},0.1]]}]&/@Range[-0.5,4,0.25],PlotRange->{{-1.1,4},{-1,4}},AxesTrue,AxesOrigin{-1,-0.8},AxesLabelEvaluate[Style[#,17]&/@{"x","r"}]//Quiet

π

2

π

2

Out[]=

Now for the bifurcation diagram we need to flip the axes, and we would get something that looks like:

In[]:=

l1={#,finsol[#][[1]]}&/@Range[0,2,0.1]//Quiet;l2={#,finsol[#][[1]]}&/@Range[-2,1,0.01]//Quiet;l3={#,finsol[#][[2]]}&/@Range[-2,1,0.01]//Quiet;l4={#,finsol[#][[1]]}&/@Range[1,2,0.01]//Quiet;l5={#,finsol[#][[2]]}&/@Range[1,2,0.1]//Quiet;ListLinePlot[{l1,l2,l3,l4,l5},PlotStyle->{{Dashed,Blue},{Blue},{Dashed,Blue},{Blue},{Dashed,Blue}},AxesLabelEvaluate[Style[#,17]&/@{"r","x"}],PlotRange->{{-1,2},{-1,4}}]

Out[]=

This is clearly a transcritical bifurcation. Where is it happening though? It seemed in the diagram to be around r=1. However, we can be precise about it. It occurs at the point where the two lines are tangent to one another, ie. where their gradients are the same. We also know that it occurs at the x value of x=0 as there is always an intersection at this point, so we can equate the gradients, and then set x=0:

ln(1+x)andrx

In[]:=

Solve==r,r[[1,1]]/.x->0

1

1+x

Out[]=

r1

OK, so that confirms our guess that the critical point is at . Can we turn the original equation into the Normal Form for a transcritical bifurcation by expanding about x=0? Let’s expand the right hand side of the equation about

(r,x)=(1,0)

x=0:

In[]:=

Series[-Log[x+1]+rx,{x,0,2}]//Normal

Out[]=

(-1+r)x+

2

x

2

And so the equation close to the critical value of x can be written as

x

2

x

2

We want the termonits own so let's multiply through by

2

x

2andweget:

2=2(r-1)x+

x

2

x

Now the left hand side is really

so let's define

and finally we have

To get the - sign, let’s let X=-χ, R=-ρ:

which is precisely the normal form of a transcritical bifurcation.