Re: Arnold's Cat Map
- To: mathgroup at smc.vnet.net
- Subject: [mg5323] Re: [mg5314] Arnold's Cat Map
- From: Gottfried Mayer-Kress <gmk at ccsr.uiuc.edu>
- Date: Wed, 27 Nov 1996 01:47:39 -0500
- Organization: Center for Complex Systems Research
- Sender: owner-wri-mathgroup at wolfram.com
wilson figueroa wrote:
>
> Hi group,
>
> I am attempting to implement Arnold's Cat Map using Mathematica
> and have received two excellent solutions.
>
Both solutions contain special symmetrical initial conditions and generate
orbits in black and white only. That symmetry can lead to misleading
conclusions about the map's typical behavior. I modified solution 2
so that the orbits are divided into three sets of different color and one "test
particle" with different denominator marked as dot of different diameter.
I think that shows more about what the cat map is all about.
Gottfried Mayer-Kress
Encl.: Solution 2a:
PointQ[p_] := VectorQ[p, NumberQ] && Length[p] == 2;
m = {{1,1}, {1,2}};
cat[x_?PointQ] := Mod[m.x, 1];
cat2[x_, 0] := x
cat[x_, 1] := cat[x]
cat2[x_, n_] := cat[cat2[x, n-1]]
period[x_] := Module[{i=2},
While[Nest[cat,x, i]=!= x, i++];
i]
In[31]:=
catgraph[r_, n_] :=
Module[{liner, lineg, lineb, line2r, line2g, line2b},
liner = Table[{i, i}/r,{i, 0, r-1,3}];
lineg = Table[{i, i}/r,{i, 1, r-1,3}];
lineb = Table[{i, i}/r,{i, 2, r-1,3}];
line2r = Apply[Point[{#1, #2}]&, liner, 1];
line2g = Apply[Point[{#1, #2}]&, lineg, 1];
line2b = Apply[Point[{#1, #2}]&, lineb, 1];
Show[
Graphics[{RGBColor[1,0,0],line2r}/.x_?PointQ :> cat2[x, n]],
Graphics[{RGBColor[0,1,0],line2g}/.x_?PointQ :> cat2[x, n]],
Graphics[{RGBColor[0,0,1],line2b}/.x_?PointQ :> cat2[x, n]],
Graphics[{PointSize[.02],Point[{1/7,1/7}]}/.x_?PointQ :> cat2[x, n]],
Graphics[Text[n,{.95,.95},{1,0}]],
Frame->True,PlotRange->{{0,1},{0,1}},
AspectRatio->Automatic
]
]
Table[catgraph[102,i],{i,0,36}];