Repeating matrix action

Ivan Cnop
Vrije universiteit Brussel
icnop@vub.ac.be

Arnold (and other) mappings

Input drawing

Plot[0, {x, 0, 1}, PlotRange -> {0, 1}, 
      AspectRatio -> Automatic]

Perform  copy-paste and name the list :

l = {{0.652204, 0.842037}, {0.628801, 0.842037}, {0.609299, 
            0.842037}, {0.581996, 0.842037}, {0.562494, 0.842037}, {0.539091, 
            0.842037}, {0.52349, 0.842037}, {0.507888, 0.842037}, {0.480585, 
            0.838137}, {0.464983, 0.838137}, {0.445481, 0.834236}, {0.425979, 
            0.830336}, {0.402577, 0.822535}, {0.379174, 0.814734}, {0.359672, 
            0.806933}, {0.336269, 0.799132}, {0.308967, 0.787431}, {0.289464, 
            0.77963}, {0.266062, 0.767929}, {0.24656, 0.752327}, {0.223157, 
            0.744527}, {0.199755, 0.728925}, {0.180253, 0.713323}, {0.160751, 
            0.701622}, {0.129547, 0.678219}, {0.110045, 
            0.666518}, {0.0983439, 0.650916}, {0.0788418, 
            0.631414}, {0.0671405, 0.608012}, {0.0593397, 
            0.58851}, {0.0515388, 0.569008}, {0.0398376, 
            0.545605}, {0.0398376, 0.530003}, {0.0359371, 
            0.514402}, {0.0320367, 0.487099}, {0.0281363, 
            0.463696}, {0.0242359, 0.432493}, {0.0203355, 
            0.412991}, {0.0203355, 0.397389}, {0.0203355, 
            0.373987}, {0.0203355, 0.350584}, {0.0242359, 
            0.331082}, {0.0281363, 0.31548}, {0.0320367, 
            0.299879}, {0.0359371, 0.284277}, {0.043738, 
            0.264775}, {0.0554392, 0.245273}, {0.0632401, 
            0.229671}, {0.0710409, 0.210169}, {0.0827422, 
            0.194567}, {0.102244, 0.167264}, {0.117846, 0.151663}, {0.141248, 
            0.132161}, {0.160751, 0.12436}, {0.180253, 0.112658}, {0.211456, 
            0.0970568}, {0.258261, 0.089256}, {0.293365, 
            0.0775547}, {0.316767, 0.0697539}, {0.347971, 
            0.0580526}, {0.371373, 0.0541522}, {0.390875, 
            0.0502518}, {0.425979, 0.0502518}, {0.461083, 
            0.0502518}, {0.500087, 0.0502518}, {0.542992, 
            0.0580526}, {0.574195, 0.0658534}, {0.601498, 
            0.0775547}, {0.636602, 0.0931564}, {0.660004, 
            0.104858}, {0.675606, 0.112658}, {0.691208, 0.120459}, {0.706809, 
            0.132161}, {0.722411, 0.143862}, {0.741913, 0.159464}, {0.761415, 
            0.171165}, {0.773117, 0.186766}, {0.788718, 0.198468}, {0.800419, 
            0.21797}, {0.827722, 0.245273}, {0.847224, 0.268675}, {0.862826, 
            0.288177}, {0.882328, 0.307679}, {0.890129, 0.327182}, {0.90183, 
            0.346684}, {0.913532, 0.366186}, {0.921332, 0.381787}, {0.925233, 
            0.397389}, {0.933034, 0.416891}, {0.936934, 0.432493}, {0.944735, 
            0.448095}, {0.944735, 0.471497}, {0.944735, 0.487099}, {0.944735, 
            0.5027}, {0.940835, 0.526103}, {0.933034, 0.549506}, {0.925233, 
            0.572908}, {0.917432, 0.58851}, {0.909631, 0.611912}, {0.90183, 
            0.627514}, {0.886229, 0.650916}, {0.870627, 0.670419}, {0.858926, 
            0.68602}, {0.843324, 0.701622}, {0.827722, 0.717224}, {0.812121, 
            0.732825}, {0.796519, 0.748427}, {0.780917, 0.764029}, {0.765316, 
            0.767929}, {0.749714, 0.771829}, {0.734112, 0.787431}, {0.262161, 
            0.288177}, {0.262161, 0.272576}, {0.281664, 0.245273}, {0.293365, 
            0.229671}, {0.308967, 0.225771}, {0.328469, 0.21797}, {0.34407, 
            0.214069}, {0.359672, 0.210169}, {0.375274, 0.210169}, {0.394776, 
            0.202368}, {0.410377, 0.202368}, {0.42988, 0.202368}, {0.449382, 
            0.202368}, {0.464983, 0.202368}, {0.484485, 0.202368}, {0.500087, 
            0.202368}, {0.519589, 0.202368}, {0.535191, 0.206269}, {0.550793, 
            0.214069}, {0.566394, 0.21797}, {0.581996, 0.233571}, {0.593697, 
            0.249173}, {0.609299, 0.256974}, {0.613199, 0.272576}, {0.305066, 
            0.59241}, {0.320668, 0.608012}, {0.336269, 0.619713}, {0.351871, 
            0.623613}, {0.367473, 0.627514}, {0.383075, 0.627514}, {0.398676, 
            0.623613}, {0.406477, 0.608012}, {0.414278, 0.59241}, {0.558593, 
            0.600211}, {0.574195, 0.611912}, {0.589797, 0.619713}, {0.605398, 
            0.623613}, {0.621, 0.623613}, {0.636602, 0.623613}, {0.652204, 
            0.615813}, {0.656104, 0.600211}, {0.663905, 0.584609}, {0.464983, 
            0.518302}, {0.464983, 0.5027}, {0.461083, 0.483198}, {0.457182, 
            0.467597}, {0.449382, 0.451995}, {0.449382, 0.436393}, {0.445481, 
            0.420792}, {0.43768, 0.40519}, {0.453282, 0.393489}, {0.468884, 
            0.389588}} ;

Control

Length[l]

ListPlot[l, AspectRatio -> Automatic, 
      Prolog -> AbsolutePointSize[3]]

Action of the Arnold matrix

once

A=(({{1, 1}, {1, 2}}))

Eigensystem[A]

Map[FractionalPart[A . #] &, l];

Map[Point, %];

Show[Graphics[%]]

several images together

image[l_] := Map[FractionalPart[A . #] &, l];

Flatten[NestList[image, l, 3], 1];

Show[Graphics[Map[Point, %]], AspectRatio -> Automatic]

after many times all information is lost

Nest[image, l, 40];

Show[Graphics[Map[Point, %]], AspectRatio -> Automatic]

Nest[image, l, 100];

Show[Graphics[Map[Point, %]], AspectRatio -> Automatic]

we obtain random points even if we start from a single point

l = {{1/3, Pi/4}} // N

Flatten[NestList[image, l, 100], 1];

Show[Graphics[Map[Point, %]], AspectRatio -> Automatic]

see = Flatten[NestList[image, l, 50], 1];

ListPlot[see, PlotJoined -> True, AspectRatio -> Automatic]

Discretisation of the action

A=(({{1, 1}, {1, 2}}))

invert

B = Inverse[A]

B // MatrixForm

\(\(max = 46
\)\)

Colourful drawings

Clear[rainbow]

rainbow[{i_, j_}] := Hue[(j + i)/2/max]

Clear[bullseye]

\(bullseye[{i_, j_}] := 
	
      Hue[2\ \(\((\((j - 20)\)^2 + \((i - 20)\)^2)\)/max\)/max]\)

Repeated action of the Arnold matrix

Show[
      Graphics[RasterArray[
          Table[rainbow[{i, j}], {i, 0, max - 1}, {j, 0, max - 1}]], 
        AspectRatio -> Automatic]]

Show[
      Graphics[RasterArray[
          Table[bullseye[{i, j}], {i, 0, max - 1}, {j, 0, max - 1}]], 
        AspectRatio -> Automatic]]

Clear[preimage]

preimage[{i_, j_}] := Mod[B.{i, j}, max]

\(Show[
	
      Graphics[
		
        RasterArray[
			
          Table[
				
            bullseye[preimage[{i, j}]], {i, 0, max - 1}, {j, 0, max - 1}]], 
        AspectRatio -> Automatic]]\)

Clear[square]

\(square[n_] := 
	
      Table[bullseye[Nest[preimage, {i, j}, n]], {i, 0, max - 1}, {j, 0, 
          max - 1}]\)

Do[Show[Graphics[RasterArray[square[n]]], AspectRatio -> Automatic], {
        n, 0, 24}]

Recursive programming

A=(({{1, 1}, {1, 2}}))

invert

B = Inverse[A]

B // MatrixForm

\(\(max = 46
\)\)

Clear[preimage]

preimage[{i_, j_}] := Mod[B.{i, j}, max]

Clear[bullseye]

\(bullseye[{i_, j_}] := 
	
      Hue[N[2\ \(\((\((j - 20)\)^2 + \((i - 20)\)^2)\)/max\)/max]]\)

\(Show[
	
      Graphics[
		
        RasterArray[
			
          Table[
				
            bullseye[{i, j}], {i, 0, max - 1}, {j, 0, max - 1}]], 
        AspectRatio -> Automatic]]\)

\(Show[
	
      Graphics[
		
        RasterArray[
			
          Table[
				
            bullseye[preimage[{i, j}]], {i, 0, max - 1}, {j, 0, max - 1}]], 
        AspectRatio -> Automatic]]\)

Clear[square]

\(\(square[0, {i_, j_}] := 	
				bullseye[{i, j}]; \)\)

Show[
      Graphics[RasterArray[
          Table[square[0, {i, j}], {i, 0, max - 1}, {j, 0, max - 1}]]], 
      AspectRatio -> Automatic]

\(\(square[n_, {i_, j_}] := 
      \(square[n, {i, j}] = 
square[n - 1, preimage[{i, j}]]\)
				
    \)\)

Show[
      Graphics[RasterArray[
          Table[square[1, {i, j}], {i, 0, max - 1}, {j, 0, max - 1}]]], 
      AspectRatio -> Automatic]

Do[Show[
        Graphics[
          RasterArray[
            Table[square[n, {i, j}], {i, 0, max - 1}, {j, 0, max - 1}]]], 
        AspectRatio -> Automatic], {n, 0, 24}]

Action of other matrices

Repeat using matrix

A=(({{1, 2}, {1, 1}}))

Eigensystem[A]

Repeat using matrix

A=(({{1, 3}, {1, 1}}))

Eigensystem[A]

Repeat using matrix

A=(({{1, 1}, {-1, 1}}))

Eigensystem[A]

Draw conclusions

Dos you always see the same periodicity?