The Hénon Map

Iterates of the map

Clear[x,y,n,a,b]
Print[Style["Fixed points",19,Blue]]
Simplify[Solve[{x==1-a x^2+y,y==b x},{x,y}]](*fixed point analytically*)

a=1.4;
b=0.3;
iter=6000;
iterplot=70;

sol=RecurrenceTable[{
x[n+1]==1-a x[n]^2+y[n],
y[n+1]==b x[n],
x[0]==0.1,y[0]==0.1},{x,y},{n,0,iter}];
fixedpoints=Quiet[Solve[{x==1-a x^2+y,y==b x},{x,y}]];
Print[Style["Fixed points, evaluated",19,Blue]]
coordinates={x,y}/.fixedpoints
fixedp=Graphics[{PointSize[0.02],Red,Point[coordinates]}];

att=ListPlot[sol,PlotMarkers->{"•",3},Frame-> True,FrameLabel->{x,y},LabelStyle->20,ImageSize->600];
Show[att,fixedp]
ListLinePlot[{sol[[All,1]],sol[[All,2]]},PlotMarkers->{"•",12},AxesLabel->{n,"(Subscript[x, n]), (Subscript[y, n])"},PlotRange->{{0,iterplot},{-1.5,1.5}},PlotLegends->{"(Subscript[x, n])","(Subscript[y, n])"},LabelStyle->20,ImageSize->600]

Iterates of the map, period-2 cycle

Clear[x,y,n,a,b]
Print[Style["Fixed points",19,Blue]]
Simplify[Solve[{x==1-a x^2+y,y==b x},{x,y}]](*fixed point analytically*)

a=0.43;
b=0.4;
iter=70;
iterplot=iter;

sol=RecurrenceTable[{
x[n+1]==1-a x[n]^2+y[n],
y[n+1]==b x[n],
x[0]==0.7,y[0]==-0.1},{x,y},{n,0,iter}];
fixedpoints=Quiet[Solve[{x==1-a x^2+y,y==b x},{x,y}]];
Print[Style["Fixed points, evaluated",19,Blue]]
coordinates={x,y}/.fixedpoints
fixedp=Graphics[{PointSize[0.02],Red,Point[coordinates]}];
att2=ListPlot[sol,PlotMarkers->{"•",14},PlotStyle->Black,Frame-> True,FrameLabel->{x,y},LabelStyle->20,AspectRatio->0.7,ImageSize->600];
Show[att2,fixedp,PlotRange->All]

ListLinePlot[{sol[[All,1]],sol[[All,2]]},PlotMarkers->{"•",14},AxesLabel->{n,"(Subscript[x, n]), (Subscript[y, n])"},PlotRange->{{0,iterplot},{-0.5,1.7}},PlotLegends->{"(Subscript[x, n])","(Subscript[y, n])"},LabelStyle->20,ImageSize->600,AspectRatio->0.7]

Zooming into the fractal microstructure at (x, y) = (1, -0.143)

Clear[x,y,n]
a=1.4;
b=0.3;
iter=180000;
solz=RecurrenceTable[{
x[n+1]==1-a x[n]^2+y[n],
y[n+1]==b x[n],
x[0]==0.1,y[0]==0.1},{x,y},{n,0,iter}];
henon=Rasterize[ListPlot[solz,PlotMarkers->{"•",3},Frame-> True,FrameLabel->{x,y},LabelStyle->20,ImageSize->600]];
circle=Graphics[{Red,Circle[{1,-0.143},0.03]}];
Show[{henon,circle}]
henonz=Rasterize[ListPlot[solz,PlotMarkers->{"•",5},Frame-> True,FrameLabel->{x,y},PlotRange->{{0.98,1.02},{-0.15,-0.13}},LabelStyle->20,ImageSize->600]];
circle2=Graphics[{Red,Circle[{1,-0.143},0.0055]}];
Show[{henonz,circle2}]
Rasterize[ListPlot[solz,PlotMarkers->{"•",5},Frame-> True,FrameLabel->{x,y},PlotRange->{{0.994,1.006},{-0.145,-0.141}},LabelStyle->20,ImageSize->600]]

Single initial condition (point) iterates, animated

Clear[x,y,nn,iter2]
iter2=2000;
a=1.4;
b=0.3;
Animate[
ListPlot[RecurrenceTable[{
x[nn+1]==1-a x[nn]^2+y[nn],
y[nn+1]==b x[nn],
x[0]==0,y[0]==0},{x,y},{nn,0,n}],
PlotRange->{{-1.5,1.5},{-0.4,0.4}},PlotMarkers->{"•",5},Frame-> True,FrameLabel->{x,y},ImageSize->550,LabelStyle->20],
{n,0,iter2,1},AnimationRunning->False,SaveDefinitions->True]

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