Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
1996
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 1996

[Date Index] [Thread Index] [Author Index]

Search the Archive

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


  • Prev by Date: Re: Rule to Function, Frontend funnies
  • Next by Date: maple -> mathematica software?
  • Previous by thread: Re: Arnold's Cat Map
  • Next by thread: Orbital propagators