Example 4.1: Nonuniqueness of the Centre Manifold (Ch 4, page 57)

Clear["Global`*"]
Off[General::spell1]

System

Parameters

{(Subscript[x, min]),(Subscript[x, max])}={-4,4};
{(Subscript[y, min]),(Subscript[y, max])}={-4,4};

f[x_,y_]:=(x^2)

g[x_,y_]:=-y

Vector field

V={f[x,y],g[x,y]}

Fixed Points & Nullclines

fp=Solve[{f[(Subscript[x, 1]),(Subscript[y, 1])]==0,g[(Subscript[x, 1]),(Subscript[y, 1])]==0},{(Subscript[x, 1]),(Subscript[y, 1])}]

fp1=Sort[fp[[1]]];

{(Subscript[x, 1]),(Subscript[y, 1])}={Extract[fp1,{1}][[2]],Extract[fp1,{2}][[2]]};
fixedpoint1=Show[Graphics[{PointSize[0.025],Hue[0.33],Point[{(Subscript[x, 1]),(Subscript[y, 1])}]},PlotRange->{{(Subscript[x, min]),(Subscript[x, max])},{(Subscript[y, min]),(Subscript[y, max])}}]];

nullclines=ContourPlot[{f[x,y]==0,g[x,y]==0},{x,(Subscript[x, min]),(Subscript[x, max])},{y,(Subscript[y, min]),(Subscript[y, max])},ContourStyle->{{Green,Thickness[0.005]}}];

Show[nullclines,fixedpoint1]

Jacobian

a11=Simplify[D[f[x,y],x]]

a12=Simplify[D[f[x,y],y]]

a21=Simplify[D[g[x,y],x]]

a22=Simplify[D[g[x,y],y]]

J={{a11,a12},{a21,a22}}

MatrixForm[J]

Acceleration

γ=J . V

Fixed Points Stability - Eigenvalues

Eigenvalues[J]/.{x-> (Subscript[x, 1]),y->(Subscript[y, 1])}

Phase Portrait

x=.
y=.
t=.

solution=NDSolve[{x'[t]==f[x[t],y[t]],x[0]==0.01,

y'[t]==g[x[t],y[t]],y[0]==6},{x,y},

{t,0,100},Method->"ExplicitRungeKutta", MaxSteps->Infinity,StartingStepSize->0.001];phaseplot1=ParametricPlot[Evaluate[{x[t],y[t]}/.solution],{t,0,10},PlotPoints->1000,PlotRange->{{(Subscript[x, min]),(Subscript[x, max])},{(Subscript[y, min]),(Subscript[y, max])}},AxesLabel->{"X","Y"},PlotStyle->{{Red,Thickness[0.005]}},AspectRatio->1,Frame->True]

tableplot={};
For[t=0,t≤2,t=t+1.25,
x=Evaluate[{x[t],y[t]}/.solution][[1]][[1]];
y=Evaluate[{x[t],y[t]}/.solution][[1]][[2]];
vx=f[x,y];
vy=g[x,y];
tmptable={{x,y},{vx,vy}};
tableplot=Append[tableplot,tmptable];];
flow1=ListVectorFieldPlot[tableplot ,ColorFunction->(Hue[0.66]&),MaxArrowLength->5,ScaleFactor->0.1,Frame->True,AspectRatio->1]

x=.
y=.
t=.

solution=NDSolve[{x'[t]==f[x[t],y[t]],x[0]==0.01,

y'[t]==g[x[t],y[t]],y[0]==-6},{x,y},

{t,0,100},Method->"ExplicitRungeKutta", MaxSteps->Infinity,StartingStepSize->0.001];phaseplot2=ParametricPlot[Evaluate[{x[t],y[t]}/.solution],{t,0,10},PlotPoints->1000,PlotRange->{{(Subscript[x, min]),(Subscript[x, max])},{(Subscript[y, min]),(Subscript[y, max])}},AxesLabel->{"X","Y"},PlotStyle->{{Red,Thickness[0.005]}},AspectRatio->1,Frame->True]

tableplot={};
For[t=0,t≤2,t=t+1.25,
x=Evaluate[{x[t],y[t]}/.solution][[1]][[1]];
y=Evaluate[{x[t],y[t]}/.solution][[1]][[2]];
vx=f[x,y];
vy=g[x,y];
tmptable={{x,y},{vx,vy}};
tableplot=Append[tableplot,tmptable];];
flow2=ListVectorFieldPlot[tableplot ,ColorFunction->(Hue[0.66]&),ScaleFactor->0.1,MaxArrowLength->5,Frame->True,AspectRatio->1]

x=.
y=.
t=.

solution=NDSolve[{x'[t]==f[x[t],y[t]],x[0]==-4,

y'[t]==g[x[t],y[t]],y[0]==4},{x,y},

{t,0,50},Method->"ExplicitRungeKutta", MaxSteps->Infinity,StartingStepSize->0.001];phaseplot3=ParametricPlot[Evaluate[{x[t],y[t]}/.solution],{t,0,10},PlotPoints->1000,PlotRange->{{(Subscript[x, min]),(Subscript[x, max])},{(Subscript[y, min]),(Subscript[y, max])}},AxesLabel->{"X","Y"},PlotStyle->{{Red,Thickness[0.005]}},AspectRatio->1,Frame->True]

tableplot={};
For[t=0,t≤0.5,t=t+0.5,
x=Evaluate[{x[t],y[t]}/.solution][[1]][[1]];
y=Evaluate[{x[t],y[t]}/.solution][[1]][[2]];
vx=f[x,y];
vy=g[x,y];
tmptable={{x,y},{vx,vy}};
tableplot=Append[tableplot,tmptable];];
flow3=ListVectorFieldPlot[tableplot ,ColorFunction->(Hue[0.66]&),ScaleFactor->0.1,MaxArrowLength->5,Frame->True,AspectRatio->1]

x=.
y=.
t=.

solution=NDSolve[{x'[t]==f[x[t],y[t]],x[0]==-4,

y'[t]==g[x[t],y[t]],y[0]==3},{x,y},

{t,0,50},Method->"ExplicitRungeKutta", MaxSteps->Infinity,StartingStepSize->0.001];phaseplot4=ParametricPlot[Evaluate[{x[t],y[t]}/.solution],{t,0,10},PlotPoints->1000,PlotRange->{{(Subscript[x, min]),(Subscript[x, max])},{(Subscript[y, min]),(Subscript[y, max])}},AxesLabel->{"X","Y"},PlotStyle->{{Red,Thickness[0.005]}},AspectRatio->1,Frame->True]

tableplot={};
For[t=0,t≤0.5,t=t+0.5,
x=Evaluate[{x[t],y[t]}/.solution][[1]][[1]];
y=Evaluate[{x[t],y[t]}/.solution][[1]][[2]];
vx=f[x,y];
vy=g[x,y];
tmptable={{x,y},{vx,vy}};
tableplot=Append[tableplot,tmptable];];
flow4=ListVectorFieldPlot[tableplot ,ColorFunction->(Hue[0.66]&),ScaleFactor->0.1,MaxArrowLength->5,Frame->True,AspectRatio->1]

x=.
y=.
t=.

solution=NDSolve[{x'[t]==f[x[t],y[t]],x[0]==-4,

y'[t]==g[x[t],y[t]],y[0]==2},{x,y},

{t,0,50},Method->"ExplicitRungeKutta", MaxSteps->Infinity,StartingStepSize->0.001];phaseplot5=ParametricPlot[Evaluate[{x[t],y[t]}/.solution],{t,0,50},PlotPoints->1000,PlotRange->{{(Subscript[x, min]),(Subscript[x, max])},{(Subscript[y, min]),(Subscript[y, max])}},AxesLabel->{"X","Y"},PlotStyle->{{Red,Thickness[0.005]}},AspectRatio->1,Frame->True]

tableplot={};
For[t=0,t≤0.5,t=t+.5,
x=Evaluate[{x[t],y[t]}/.solution][[1]][[1]];
y=Evaluate[{x[t],y[t]}/.solution][[1]][[2]];
vx=f[x,y];
vy=g[x,y];
tmptable={{x,y},{vx,vy}};
tableplot=Append[tableplot,tmptable];];
flow5=ListVectorFieldPlot[tableplot ,ColorFunction->(Hue[0.66]&),ScaleFactor->0.1,MaxArrowLength->5,Frame->True,AspectRatio->1]

Show[phaseplot5,flow5,phaseplot4,flow4,phaseplot3,flow3,ImageSize->{600,600}]

x=.
y=.
t=.

solution=NDSolve[{x'[t]==f[x[t],y[t]],x[0]==-4,

y'[t]==g[x[t],y[t]],y[0]==0},{x,y},

{t,0,50},Method->"ExplicitRungeKutta", MaxSteps->Infinity,StartingStepSize->0.001];phaseplot6=ParametricPlot[Evaluate[{x[t],y[t]}/.solution],{t,0,10},PlotPoints->1000,PlotRange->{{(Subscript[x, min]),(Subscript[x, max])},{(Subscript[y, min]),(Subscript[y, max])}},AxesLabel->{"X","Y"},PlotStyle->{{Red,Thickness[0.005]}},AspectRatio->1,Frame->True]

tableplot={};
For[t=0,t≤0.5,t=t+.5,
x=Evaluate[{x[t],y[t]}/.solution][[1]][[1]];
y=Evaluate[{x[t],y[t]}/.solution][[1]][[2]];
vx=f[x,y];
vy=g[x,y];
tmptable={{x,y},{vx,vy}};
tableplot=Append[tableplot,tmptable];];
flow6=ListVectorFieldPlot[tableplot ,ColorFunction->(Hue[0.66]&),ScaleFactor->0.1,MaxArrowLength->5,Frame->True,AspectRatio->1]

x=.
y=.
t=.

solution=NDSolve[{x'[t]==f[x[t],y[t]],x[0]==-4,

y'[t]==g[x[t],y[t]],y[0]==-4},{x,y},

{t,0,50},Method->"ExplicitRungeKutta", MaxSteps->Infinity,StartingStepSize->0.001];phaseplot7=ParametricPlot[Evaluate[{x[t],y[t]}/.solution],{t,0,10},PlotPoints->1000,PlotRange->{{(Subscript[x, min]),(Subscript[x, max])},{(Subscript[y, min]),(Subscript[y, max])}},AxesLabel->{"X","Y"},PlotStyle->{{Red,Thickness[0.005]}},AspectRatio->1,Frame->True]

tableplot={};
For[t=0,t≤0.5,t=t+0.5,
x=Evaluate[{x[t],y[t]}/.solution][[1]][[1]];
y=Evaluate[{x[t],y[t]}/.solution][[1]][[2]];
vx=f[x,y];
vy=g[x,y];
tmptable={{x,y},{vx,vy}};
tableplot=Append[tableplot,tmptable];];
flow7=ListVectorFieldPlot[tableplot ,ColorFunction->(Hue[0.66]&),ScaleFactor->0.1,MaxArrowLength->5,Frame->True,AspectRatio->1]

x=.
y=.
t=.

solution=NDSolve[{x'[t]==f[x[t],y[t]],x[0]==-4,

y'[t]==g[x[t],y[t]],y[0]==-3},{x,y},

{t,0,50},Method->"ExplicitRungeKutta", MaxSteps->Infinity,StartingStepSize->0.001];phaseplot8=ParametricPlot[Evaluate[{x[t],y[t]}/.solution],{t,0,10},PlotPoints->1000,PlotRange->{{(Subscript[x, min]),(Subscript[x, max])},{(Subscript[y, min]),(Subscript[y, max])}},AxesLabel->{"X","Y"},PlotStyle->{{Red,Thickness[0.005]}},AspectRatio->1,Frame->True]

tableplot={};
For[t=0,t≤0.5,t=t+0.5,
x=Evaluate[{x[t],y[t]}/.solution][[1]][[1]];
y=Evaluate[{x[t],y[t]}/.solution][[1]][[2]];
vx=f[x,y];
vy=g[x,y];
tmptable={{x,y},{vx,vy}};
tableplot=Append[tableplot,tmptable];];
flow8=ListVectorFieldPlot[tableplot ,ColorFunction->(Hue[0.66]&),ScaleFactor->0.1,MaxArrowLength->5,Frame->True,AspectRatio->1]

x=.
y=.
t=.

solution=NDSolve[{x'[t]==f[x[t],y[t]],x[0]==-4,

y'[t]==g[x[t],y[t]],y[0]==-2},{x,y},

{t,0,50},Method->"ExplicitRungeKutta", MaxSteps->Infinity,StartingStepSize->0.001];phaseplot9=ParametricPlot[Evaluate[{x[t],y[t]}/.solution],{t,0,50},PlotPoints->1000,PlotRange->{{(Subscript[x, min]),(Subscript[x, max])},{(Subscript[y, min]),(Subscript[y, max])}},AxesLabel->{"X","Y"},PlotStyle->{{Red,Thickness[0.005]}},AspectRatio->1,Frame->True]

tableplot={};
For[t=0,t≤0.5,t=t+.5,
x=Evaluate[{x[t],y[t]}/.solution][[1]][[1]];
y=Evaluate[{x[t],y[t]}/.solution][[1]][[2]];
vx=f[x,y];
vy=g[x,y];
tmptable={{x,y},{vx,vy}};
tableplot=Append[tableplot,tmptable];];
flow9=ListVectorFieldPlot[tableplot ,ColorFunction->(Hue[0.66]&),ScaleFactor->0.1,MaxArrowLength->5,Frame->True,AspectRatio->1]

x=.
y=.
t=.

solution=NDSolve[{x'[t]==f[x[t],y[t]],x[0]==.5,

y'[t]==g[x[t],y[t]],y[0]==4},{x,y},

{t,0,2},Method->"ExplicitRungeKutta", MaxSteps->Infinity,StartingStepSize->0.0001];phaseplot10=ParametricPlot[Evaluate[{x[t],y[t]}/.solution],{t,0,1.9},PlotPoints->1000,PlotRange->{{(Subscript[x, min]),(Subscript[x, max])},{(Subscript[y, min]),(Subscript[y, max])}},AxesLabel->{"X","Y"},PlotStyle->{{Red,Thickness[0.005]}},AspectRatio->1,Frame->True]

tableplot={};
For[t=1.5,t≤1.9,t=t+1,
x=Evaluate[{x[t],y[t]}/.solution][[1]][[1]];
y=Evaluate[{x[t],y[t]}/.solution][[1]][[2]];
vx=f[x,y];
vy=g[x,y];
tmptable={{x,y},{vx,vy}};
tableplot=Append[tableplot,tmptable];];
flow10=ListVectorFieldPlot[tableplot ,ColorFunction->(Hue[0.66]&),ScaleFactor->0.1,MaxArrowLength->5,Frame->True,AspectRatio->1]

x=.
y=.
t=.

solution=NDSolve[{x'[t]==f[x[t],y[t]],x[0]==.3,

y'[t]==g[x[t],y[t]],y[0]==4},{x,y},

{t,0,3.2},Method->"ExplicitRungeKutta", MaxSteps->Infinity,StartingStepSize->0.0001];phaseplot11=ParametricPlot[Evaluate[{x[t],y[t]}/.solution],{t,0,3.2},PlotPoints->1000,PlotRange->{{(Subscript[x, min]),(Subscript[x, max])},{(Subscript[y, min]),(Subscript[y, max])}},AxesLabel->{"X","Y"},PlotStyle->{{Red,Thickness[0.005]}},AspectRatio->1,Frame->True]

tableplot={};
For[t=2.5,t≤3.2,t=t+1,
x=Evaluate[{x[t],y[t]}/.solution][[1]][[1]];
y=Evaluate[{x[t],y[t]}/.solution][[1]][[2]];
vx=f[x,y];
vy=g[x,y];
tmptable={{x,y},{vx,vy}};
tableplot=Append[tableplot,tmptable];];
flow11=ListVectorFieldPlot[tableplot ,ColorFunction->(Hue[0.66]&),ScaleFactor->0.1,MaxArrowLength->5,Frame->True,AspectRatio->1]

x=.
y=.
t=.

solution=NDSolve[{x'[t]==f[x[t],y[t]],x[0]==.5,

y'[t]==g[x[t],y[t]],y[0]==-4},{x,y},

{t,0,2},Method->"ExplicitRungeKutta", MaxSteps->Infinity,StartingStepSize->0.0001];phaseplot12=ParametricPlot[Evaluate[{x[t],y[t]}/.solution],{t,0,1.9},PlotPoints->1000,PlotRange->{{(Subscript[x, min]),(Subscript[x, max])},{(Subscript[y, min]),(Subscript[y, max])}},AxesLabel->{"X","Y"},PlotStyle->{{Red,Thickness[0.005]}},AspectRatio->1,Frame->True]

tableplot={};
For[t=1.5,t≤1.9,t=t+1,
x=Evaluate[{x[t],y[t]}/.solution][[1]][[1]];
y=Evaluate[{x[t],y[t]}/.solution][[1]][[2]];
vx=f[x,y];
vy=g[x,y];
tmptable={{x,y},{vx,vy}};
tableplot=Append[tableplot,tmptable];];
flow12=ListVectorFieldPlot[tableplot ,ColorFunction->(Hue[0.66]&),ScaleFactor->0.1,MaxArrowLength->5,Frame->True,AspectRatio->1]

x=.
y=.
t=.

solution=NDSolve[{x'[t]==f[x[t],y[t]],x[0]==.3,

y'[t]==g[x[t],y[t]],y[0]==-4},{x,y},

{t,0,3.2},Method->"ExplicitRungeKutta", MaxSteps->Infinity,StartingStepSize->0.0001];phaseplot13=ParametricPlot[Evaluate[{x[t],y[t]}/.solution],{t,0,3.2},PlotPoints->1000,PlotRange->{{(Subscript[x, min]),(Subscript[x, max])},{(Subscript[y, min]),(Subscript[y, max])}},AxesLabel->{"X","Y"},PlotStyle->{{Red,Thickness[0.005]}},AspectRatio->1,Frame->True]

tableplot={};
For[t=2.5,t≤3.2,t=t+1,
x=Evaluate[{x[t],y[t]}/.solution][[1]][[1]];
y=Evaluate[{x[t],y[t]}/.solution][[1]][[2]];
vx=f[x,y];
vy=g[x,y];
tmptable={{x,y},{vx,vy}};
tableplot=Append[tableplot,tmptable];];
flow13=ListVectorFieldPlot[tableplot ,ColorFunction->(Hue[0.66]&),ScaleFactor->0.1,MaxArrowLength->5,Frame->True,AspectRatio->1]

x=.
y=.
t=.

solution=NDSolve[{x'[t]==f[x[t],y[t]],x[0]==.01,

y'[t]==g[x[t],y[t]],y[0]==.01},{x,y},

{t,0,100},Method->"ExplicitRungeKutta", MaxSteps->Infinity,StartingStepSize->0.00001];phaseplot14=ParametricPlot[Evaluate[{x[t],y[t]}/.solution],{t,0,100},PlotPoints->1000,PlotRange->{{(Subscript[x, min]),(Subscript[x, max])},{(Subscript[y, min]),(Subscript[y, max])}},AxesLabel->{"X","Y"},PlotStyle->{{Green,Thickness[0.005]}},AspectRatio->1,Frame->True]

tableplot={};
For[t=99.5,t≤100,t=t+.1,
x=Evaluate[{x[t],y[t]}/.solution][[1]][[1]];
y=Evaluate[{x[t],y[t]}/.solution][[1]][[2]];
vx=f[x,y];
vy=g[x,y];
tmptable={{x,y},{vx,vy}};
tableplot=Append[tableplot,tmptable];];
flow14=ListVectorFieldPlot[tableplot ,ColorFunction->None,ScaleFactor->0.1,MaxArrowLength->5,Frame->True,AspectRatio->1]

Show[phaseplot14,flow14,phaseplot13,flow13,phaseplot12,flow12,phaseplot11,flow11,phaseplot10,flow10,phaseplot9,flow9,phaseplot8,flow8,phaseplot7,flow7,phaseplot6,flow6,phaseplot5,flow5,phaseplot4,flow4,phaseplot3,flow3,phaseplot2,flow2,phaseplot1,flow1,fixedpoint1,ImageSize->{600,600}]

Flow Curvature Manifold

ϕ=FullSimplify[Det[{V,γ}]]

flowmanifold=ContourPlot[{ϕ==0},{x,(Subscript[x, min]),(Subscript[x, max])},{y,(Subscript[y, min]),(Subscript[y, max])},ContourStyle->{{Blue,Thickness[0.005]}},PlotPoints->25,AspectRatio->1,Frame->True]

Flow Curvature Invariance

ϕ=(x^a)(y^b)

Normal Vector

η={D[ϕ,x],D[ϕ,y]}

Invariance

Ψ=FullSimplify[V . η]

FullSimplify[(Ψ/ϕ)]