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

Re: Map Attractors in Mathematica

• To: mathgroup at smc.vnet.net
• Subject: [mg3056] Re: [mg3048] Map Attractors in Mathematica
• From: Preston Nichols <nichols at godel.math.cmu.edu>
• Date: Tue, 30 Jan 1996 02:21:38 -0500
• Sender: owner-wri-mathgroup at wri.com

Jonathan Lee <bobjon at gatewest.net> in [mg3048] wrote:

>>>>
I am looking for a way to generate chaotic maps in Mathematica. The  
idea is to plot the orbits of all points in a rectangular region  
under a given transformation (x,y)->(f(x,y),g(x,y)). For example,  
the Arnol'd's cat map based on the transformation (x,y)->(x+y mod  
1,x+2y mod 1) is based on stretching out a unit square to twice it's  
original width and three times it's original height to produce 6  
unit squares which are all mashed together (basically they are  
layered on top of one another). The trick is that the unit square  
has some sort of shape in it (traditionally a cat's face), which is  
also appropriately distorted.If anyone has any suggestions on how to  
generate various iterations of this or any other map all and any  
help is appreciated. Thanks in advance.
<<<<

I can offer the beginning of an answer.

A few months ago, I decided to see if I could invent an iterated  
function system to reproduce some pictures in a paperback edition of  
Jurrassic Park by Michel Crichton.

Here's the code I came up with to solve the exercise I had set  
myself.  Modifying it to iterate other functions may do what you  
want.  The complete notebook is available from:

http://www.contrib.andrew.cmu.edu/pdn/mmantbks.html

-----------------------------------------------
PointListQ[X_] := MatchQ[Dimensions[X], {_,2}];

onestep[X_?PointListQ] := Module[{y1=N[X],y2,m},
		m = {{0,1},{-1,0}};
		y1 = (# - y1[[1]])& /@ y1;
		y2 = (m.#)& /@ y1;
		Return[Reverse[y1]~Join~y2]
		]
		
psteps[X_?PointListQ,1] :=
			psteps[X,1] = onestep[X]

psteps[X_?PointListQ,p_?IntegerQ] :=
			psteps[X,p] = onestep[psteps[X,p-1]]

ShowLines[X_?PointListQ] := Show[Graphics[Line[X]],
					AspectRatio->Automatic]
(*
The function onestep, which is being iterated, takes a list of  
points and appends to it a copy of itself rotated about its first  
point.  (The matrix m is the rotation matrix, and could easily be  
made an input variable.)

This is designed for an initial set something like

start = {{0,0},{1,0}};

and then try, for example,

ShowLines[psteps[start,10]]
*)
-----------------------------------------------------
One could use

psteps[X_?PointListQ,p_?IntegerQ] := Nest[onestep, X, p],

which is logically equivalent to my code, but my way is faster if  
you plan to generate pictures corresponding to various numbers of  
iterations.  This is because the assignment inside my definition of  
psteps makes Mathematica "remember" previous results, which can then  
be used "directly" when you ask for a larger number of iterations.   
Unfortunately, this approach might backfire if you try to run  
really large numbers of iterations, because Mathematica will have to  
remember so much.  (On the other hand, I don't really know whether  
using Nest avoids that problem.)

Other than this, I haven't done anything at all that a more  
sophisticated programmer might have done to make my code efficient.

-----------------------------------------------------
Good Luck!

Preston Nichols
Visiting Assistant Professor
Department of Mathematics
Carnegie Mellon University

==== [MESSAGE SEPARATOR] ====