Example 10.3: Centre Manifold depending upon a parameter 2D (Ch 10, page 169)

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

<<VectorFieldPlots`;

System

Parameters

f[x_,y_]:=(β/δ)(x+y) -(1/δ)(x +y)^2

g[x_,y_]:=-(β/δ)(x+y)+(1/δ)(((x+y))^2) - δ y

Vector field

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

Fixed Points

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]]];fp2=Sort[fp[[2]]];

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

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

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])}

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

Flow Curvature Manifold

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

Centre Manifold Approximation by Flow Curvature Method (Proposition 10.2)

Coefficient (Subscript[a, 10]) (K10)

K10=FullSimplify[-((D[ϕ,x])/(D[ϕ,y]))/.{y->(Subscript[a, 20]) (x^2) + (Subscript[a, 11]) β x + (Subscript[a, 02]) (β^2)}]

Coefficient (Subscript[a, 01]) (K01)

K01=Factor[-((D[ϕ,β])/(D[ϕ,y]))/.{y->(Subscript[a, 20]) (x^2) + (Subscript[a, 11]) β x + (Subscript[a, 02]) (β^2)}]

Coefficient (Subscript[a, 20])

FullSimplify[FullSimplify[D[K10,x]/.{β->0}]/.{x-> 0}]

Solve[2(Subscript[a, 20])==(4/(δ^2))-2(Subscript[a, 20]) ,(Subscript[a, 20])]

Coefficient (Subscript[a, 11])

FullSimplify[FullSimplify[D[K10,β]/.{β->0}]/.{x->0}]

Solve[(Subscript[a, 11])==-(2/(δ^2))-2 (Subscript[a, 11])-(Subscript[a, 20]),(Subscript[a, 11])]

Thus,

{(Subscript[a, 11])->((-2-(δ^2) (Subscript[a, 20]))/(3 (δ^2)))}/.{(Subscript[a, 20])->(1/(δ^2))}

Coefficient (Subscript[a, 02])

FullSimplify[FullSimplify[D[K01,β]/.{x->0}]/.{β->0}]

Solve[2(Subscript[a, 02])==-((2 (Subscript[a, 2]))/(2+3 (δ^2) (Subscript[a, 2]))),(Subscript[a, 02])]

Centre Manifold Approximation by Flow Curvature Method (Identification, cf. remark page 166)

Let' s plug inside the flow curvature manifold the centre manifold approximation with its unknown coefficients. An identification order by order leads to :

ϕ=Factor[(((((x+y))^2) (((x+y-β))^2))/δ)+y ((y^2)+x (-x+β)) δ/.{y->(Subscript[a, 20]) (x^2) + (Subscript[a, 11]) β x + (Subscript[a, 02]) (β^2)}]

Q=((x^4)-2 (x^3) β+(x^2) (β^2)+4 (x^3) (β^2) (Subscript[a, 2])-6 (x^2) (β^3) (Subscript[a, 2])+2 x (β^4) (Subscript[a, 2])-(x^2) (β^2) (δ^2) (Subscript[a, 2])+x (β^3) (δ^2) (Subscript[a, 2])+6 (x^2) (β^4) (Subscript[a, 2]^2)-6 x (β^5) (Subscript[a, 2]^2)+(β^6) (Subscript[a, 2]^2)+4 x (β^6) (Subscript[a, 2]^3)-2 (β^7) (Subscript[a, 2]^3)+(β^6) (δ^2) (Subscript[a, 2]^3)+(β^8) (Subscript[a, 2]^4)+4 (x^4) β (Subscript[a, 11])-6 (x^3) (β^2) (Subscript[a, 11])+2 (x^2) (β^3) (Subscript[a, 11])-(x^3) β (δ^2) (Subscript[a, 11])+(x^2) (β^2) (δ^2) (Subscript[a, 11])+12 (x^3) (β^3) (Subscript[a, 2]) (Subscript[a, 11])-12 (x^2) (β^4) (Subscript[a, 2]) (Subscript[a, 11])+2 x (β^5) (Subscript[a, 2]) (Subscript[a, 11])+12 (x^2) (β^5) (Subscript[a, 2]^2) (Subscript[a, 11])-6 x (β^6) (Subscript[a, 2]^2) (Subscript[a, 11])+3 x (β^5) (δ^2) (Subscript[a, 2]^2) (Subscript[a, 11])+4 x (β^7) (Subscript[a, 2]^3) (Subscript[a, 11])+6 (x^4) (β^2) (Subscript[a, 11]^2)-6 (x^3) (β^3) (Subscript[a, 11]^2)+(x^2) (β^4) (Subscript[a, 11]^2)+12 (x^3) (β^4) (Subscript[a, 2]) (Subscript[a, 11]^2)-6 (x^2) (β^5) (Subscript[a, 2]) (Subscript[a, 11]^2)+3 (x^2) (β^4) (δ^2) (Subscript[a, 2]) (Subscript[a, 11]^2)+6 (x^2) (β^6) (Subscript[a, 2]^2) (Subscript[a, 11]^2)+4 (x^4) (β^3) (Subscript[a, 11]^3)-2 (x^3) (β^4) (Subscript[a, 11]^3)+(x^3) (β^3) (δ^2) (Subscript[a, 11]^3)+4 (x^3) (β^5) (Subscript[a, 2]) (Subscript[a, 11]^3)+(x^4) (β^4) (Subscript[a, 11]^4)+4 (x^5) (Subscript[a, 20])-6 (x^4) β (Subscript[a, 20])+2 (x^3) (β^2) (Subscript[a, 20])-(x^4) (δ^2) (Subscript[a, 20])+(x^3) β (δ^2) (Subscript[a, 20])+12 (x^4) (β^2) (Subscript[a, 2]) (Subscript[a, 20])-12 (x^3) (β^3) (Subscript[a, 2]) (Subscript[a, 20])+2 (x^2) (β^4) (Subscript[a, 2]) (Subscript[a, 20])+12 (x^3) (β^4) (Subscript[a, 2]^2) (Subscript[a, 20])-6 (x^2) (β^5) (Subscript[a, 2]^2) (Subscript[a, 20])+3 (x^2) (β^4) (δ^2) (Subscript[a, 2]^2) (Subscript[a, 20])+4 (x^2) (β^6) (Subscript[a, 2]^3) (Subscript[a, 20])+12 (x^5) β (Subscript[a, 11]) (Subscript[a, 20])-12 (x^4) (β^2) (Subscript[a, 11]) (Subscript[a, 20])+2 (x^3) (β^3) (Subscript[a, 11]) (Subscript[a, 20])+24 (x^4) (β^3) (Subscript[a, 2]) (Subscript[a, 11]) (Subscript[a, 20])-12 (x^3) (β^4) (Subscript[a, 2]) (Subscript[a, 11]) (Subscript[a, 20])+6 (x^3) (β^3) (δ^2) (Subscript[a, 2]) (Subscript[a, 11]) (Subscript[a, 20])+12 (x^3) (β^5) (Subscript[a, 2]^2) (Subscript[a, 11]) (Subscript[a, 20])+12 (x^5) (β^2) (Subscript[a, 11]^2) (Subscript[a, 20])-6 (x^4) (β^3) (Subscript[a, 11]^2) (Subscript[a, 20])+3 (x^4) (β^2) (δ^2) (Subscript[a, 11]^2) (Subscript[a, 20])+12 (x^4) (β^4) (Subscript[a, 2]) (Subscript[a, 11]^2) (Subscript[a, 20])+4 (x^5) (β^3) (Subscript[a, 11]^3) (Subscript[a, 20])+6 (x^6) (Subscript[a, 20]^2)-6 (x^5) β (Subscript[a, 20]^2)+(x^4) (β^2) (Subscript[a, 20]^2)+12 (x^5) (β^2) (Subscript[a, 2]) (Subscript[a, 20]^2)-6 (x^4) (β^3) (Subscript[a, 2]) (Subscript[a, 20]^2)+3 (x^4) (β^2) (δ^2) (Subscript[a, 2]) (Subscript[a, 20]^2)+6 (x^4) (β^4) (Subscript[a, 2]^2) (Subscript[a, 20]^2)+12 (x^6) β (Subscript[a, 11]) (Subscript[a, 20]^2)-6 (x^5) (β^2) (Subscript[a, 11]) (Subscript[a, 20]^2)+3 (x^5) β (δ^2) (Subscript[a, 11]) (Subscript[a, 20]^2)+12 (x^5) (β^3) (Subscript[a, 2]) (Subscript[a, 11]) (Subscript[a, 20]^2)+6 (x^6) (β^2) (Subscript[a, 11]^2) (Subscript[a, 20]^2)+4 (x^7) (Subscript[a, 20]^3)-2 (x^6) β (Subscript[a, 20]^3)+(x^6) (δ^2) (Subscript[a, 20]^3)+4 (x^6) (β^2) (Subscript[a, 2]) (Subscript[a, 20]^3)+4 (x^7) β (Subscript[a, 11]) (Subscript[a, 20]^3)+(x^8) (Subscript[a, 20]^4))

Collect[ϕ,x]

Coefficient[ϕ,x^4]/.{β->0}

Solve[((1-(δ^2) (Subscript[a, 20]))/δ)==0,(Subscript[a, 20])]

Coefficient[ϕ,x^3β]

Solve[((-2-(δ^2) (Subscript[a, 11])+(δ^2) (Subscript[a, 20]))/δ)==0,(Subscript[a, 11])]/.{(Subscript[a, 20])->(1/(δ^2))}

Coefficient[ϕ,x^2β^2]

Solve[((1-(δ^2) (Subscript[a, 2])+(δ^2) (Subscript[a, 11]))/δ)==0,(Subscript[a, 2])]/.{(Subscript[a, 11])->-(1/(δ^2))}

This difference provides from the nonuniqueness of the Centre Manifold (Cf. concluding remark of Example11.1 page 192).