Linear analysis of the Hénon map

Linearisation about the fixed points, iterate dynamics

Clear[diffX,diffY,x,y,a,b,map,d,map1];
imsize=250;xlim=2;ylim=2;rectangleE=0.40;
frame=8;
points=300;(*points per frame*)
icoord=RandomReal[{-rectangleE,rectangleE},{points,2}];(*IC: random points in a square*)
a=1.4;b=0.3;

diffX=1-a (x^2)+y;(*Henon map definition*)
diffY=b x;

fixedpoints=Quiet[Solve[{diffX==x,diffY==y},{x,y}]];
aa={diffX,diffY};
Print[Style["Jacobian matrix",18,Blue]]
D[aa,{{x,y}}]//MatrixForm (*Jacobian*)
Jfp=D[aa,{{x,y}}]/.fixedpoints ; (*lin. systems' matrices about f.p.s*)
Print[Style["Jacobian matric about f.p.s",18,Blue]]
Map[MatrixForm][Jfp]
Style[StringForm["Determinants are ``, determines the value of the resulting area.",Map[Det][Jfp]] ,Blue,18]
Style[StringForm["Matrix traces are ``",Map[Tr][Jfp]],Blue,18] 
Style[StringForm["Eigenvalues are ``",Map[Eigenvalues][Jfp]] ,Blue,18]
ev=Map[Eigenvectors][Jfp];
Style[StringForm["Eigenvectors are ``",ev] ,Blue,15]
coordinates={x,y}/.fixedpoints;
Style[StringForm["F.p.s coordinates are ``",coordinates] ,Blue,18]
fixedp=Graphics[{PointSize[0.014],Red,Point[coordinates]}];fixedp0=Graphics[{PointSize[0.03],Red,Point[{0,0}]}];
evp1=Graphics[{Red,Arrow[{{0,0},#}]&/@ev[[1]]}];
spFP1=Show[evp1,fixedp0];

evp2=Graphics[{Red,Arrow[{{0,0},#}]&/@ev[[2]]}];
spFP2=Show[evp2,fixedp0];
(*at nonlinear map*)
mapH[ic_,d_]:={1-a ic[[d,1]]^2+ic[[d,2]],b ic[[d,1]]}
solH=NestList[
Table[mapH[#,i],{i,1,points,1}]
&,icoord,frame];
map1=ListAnimate[
Table[Show[ListPlot[solH[[i]],PlotRange->{{-1.5,1.4},{-0.4,0.5}},Frame-> True,PlotStyle->Black,PlotMarkers->{"•",6},FrameLabel->{x,y},LabelStyle->18,ImageSize->3 imsize],fixedp],
{i,1,frame}],
AnimationRunning->False,SaveDefinitions->True];
(*at the first f.p*)
mapFP1[ic_,a_]:={(Jfp[[1]].(({{ic[[a,1]]}, {ic[[a,2]]}})))[[1,1]],(Jfp[[1]].(({{ic[[a,1]]}, {ic[[a,2]]}})))[[2,1]]}
solFP1=NestList[
Table[mapFP1[#,i],{i,1,points,1}]
&,icoord,frame];
map2=ListAnimate[
Table[Show[ListPlot[solFP1[[i]],PlotRange->{{-xlim,xlim},{-ylim,ylim}},Frame-> True,PlotStyle->Black,PlotMarkers->{"•",6},FrameLabel->{u,v},AspectRatio->0.8,LabelStyle->18,ImageSize->1.4 imsize],spFP1],
{i,1,frame}],
AnimationRunning->False,SaveDefinitions->True];
(*at the second f.p*)
mapFP2[ic_,a_]:={(Jfp[[2]].(({{ic[[a,1]]}, {ic[[a,2]]}})))[[1,1]],(Jfp[[2]].(({{ic[[a,1]]}, {ic[[a,2]]}})))[[2,1]]}
solFP2=NestList[
Table[mapFP2[#,i],{i,1,points,1}]
&,icoord,frame];
map3=ListAnimate[
Table[Show[ListPlot[solFP2[[i]],PlotRange->{{-xlim,xlim},{-ylim,ylim}},Frame-> True,PlotStyle->Black,PlotMarkers->{"•",6},FrameLabel->{u,v},AspectRatio->0.8,LabelStyle->18,ImageSize->1.4 imsize],spFP2],
{i,1,frame}],
AnimationRunning->False,SaveDefinitions->True];
Grid[{{map1,SpanFromLeft},{map2,map3}},Frame->All]

Linearisation about the fixed points, phase portraits

Clear[map]
Manipulate[
xlim=1.7;ylim=0.5;
(*nonlinear*)
fixedpoints=Quiet[Solve[{1-1.4 (x^2)+y==x,0.3 x==y},{x,y}]];
coordinates={x,y}/.fixedpoints;
fixedp=Graphics[{PointSize[0.014],Red,Point[coordinates]}];
icoord=Flatten[Table[{i,j},{i,-xlim,xlim,0.5},{j,-ylim,ylim,0.2}],1];
points=Length[icoord];
map[ic_,i_]:={1-1.4 ic[[i,1]]^2+ic[[i,2]],0.3 ic[[i,1]]};
sol=NestList[Table[map[#,i],{i,1,points,1}]&,icoord,frame];
rsol=ArrayReshape[Transpose[sol],{points,frame+1,2}];(*reshapng the array*)
nlpp=Show[ListPlot[rsol,PlotRange->{{-xlim,xlim},{-ylim,ylim}},Frame-> True,PlotStyle->Black,PlotMarkers->{"•",8},FrameLabel->{x,y},AspectRatio->0.9,LabelStyle->20,ImageSize->550,Joined->True],fixedp];
(*fixed point 1 and 2 use this*)
fp0=Graphics[{PointSize[0.03],Red,Point[{0,0}]}];
icoord=Flatten[Table[{i,j},{i,-2,2,0.5},{j,-2,2,0.5}],1];
points=Length[icoord];
(*fixed point 1*)
A={{3.167792535850613`,1},{0.3,0}};
dtxt1=Text@Style[StringForm["Eigenvalues (Subscript[λ, 1]) and (Subscript[λ, 2]) are ``, minus forces the iterates to jump around the corresponding manifold.",Eigenvalues[A]] ,12];
dtxt2=Text@Style[StringForm["Determinant Δ is ``, absolute value is proportional to the change in area.",Det[A]]  ,12];
dtxt3=Text@Style[StringForm["Matrix trace τ is ``",Tr[A]]   ,12];
map2[ic_,i_]:={3.167792535850613` ic[[i,1]]+1 ic[[i,2]],0.3 ic[[i,1]]};
sol2=NestList[Table[map2[#,i],{i,1,points,1}]&,icoord,frame];
rsol2=ArrayReshape[Transpose[sol2],{points,frame+1,2}];(*reshapng the array*)
lppp=Show[ListPlot[rsol2,PlotRange->{{-2,2},{-2,2}},Frame-> True,PlotStyle->Black,PlotMarkers->{"•",8},FrameLabel->{u,v},AspectRatio->0.9,LabelStyle->20,ImageSize->360,Joined->True],fp0];
lphfp1=Column[{lppp,dtxt1,dtxt2,dtxt3}];
(*fixed point 2*)
A2={{-1.7677925358506132`,1},{0.3,0}};
dtxt12=Text@Style[StringForm["Eigenvalues (Subscript[λ, 1]) and (Subscript[λ, 2]) are ``, minus forces the iterates to jump around the corresponding manifold.",Eigenvalues[A2]] ,12];
dtxt22=Text@Style[StringForm["Determinant Δ is ``, absolute value is proportional to the change in area.",Det[A2]]  ,12];
dtxt32=Text@Style[StringForm["Matrix trace τ is ``",Tr[A2]]   ,12];
map3[ic_,i_]:={-1.7677925358506132` ic[[i,1]]+1 ic[[i,2]],0.3 ic[[i,1]]};
sol3=NestList[Table[map3[#,i],{i,1,points,1}]&,icoord,frame];
rsol3=ArrayReshape[Transpose[sol3],{points,frame+1,2}];(*reshapng the array*)
lppp2=Show[ListPlot[rsol3,PlotRange->{{-2,2},{-2,2}},Frame-> True,PlotStyle->Black,PlotMarkers->{"•",8},FrameLabel->{u,v},AspectRatio->0.9,LabelStyle->20,ImageSize->360,Joined->True],fp0];
lphfp2=Column[{lppp2,dtxt12,dtxt22,dtxt32}];
(*result plotting*)
Grid[{{nlpp,SpanFromLeft},{lphfp1,lphfp2}},Frame->All],
{{frame,3,"Number of iterations n"},1,10,1,Appearance->"Labeled"},
SaveDefinitions->True,TrackedSymbols:>{frame}]

Linearisation about the fixed points, no parameter assignments

Clear[diffX,diffY,x,y,a,b];
diffX=1-a (x^2)+y;(*Henon map definition*)
diffY=b x;

fixedpoints=Simplify[Quiet[Solve[{diffX==x,diffY==y},{x,y}]]];
aa={diffX,diffY};
Print[Style["Jacobian matrix",18,Blue]]
Simplify[D[aa,{{x,y}}]]//MatrixForm (*Jacobian*)
Jfp=Simplify[D[aa,{{x,y}}]/.fixedpoints] ; (*lin. systems' matrices about f.p.s*)
Print[Style["Jacobian matric about f.p.s",18,Blue]]
Map[MatrixForm][Jfp]
Style[StringForm["Determinants are ``, determines the value of the resulting area.",Map[Det][Jfp]] ,Blue,18]
Style[StringForm["Matrix traces are ``",Map[Tr][Jfp]],Blue,18] 
Style[StringForm["Eigenvalues are ``",Map[Eigenvalues][Jfp]] ,Blue,18]
ev=Map[Eigenvectors][Jfp];
Style[StringForm["Eigenvectors are ``",ev] ,Blue,15]
coordinates={x,y}/.fixedpoints;
Style[StringForm["F.p.s coordinates are ``",coordinates] ,Blue,18]

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