ikeda map

Continuing the theme of strange attractors, here's the well-known one embedded in the Ikeda map. The thumbnail at left shows the central 'vortex' of the attractor, and links to a larger viewport.

In these images, I've plotted the real and imaginary components along the x and y axes respectively. But the more popular way to visualize this attractor adds an extra parameter to the system and is expressed in trigonometric functions. Such adaptation of the code below yields these results.

	{-# LANGUAGE NoMonomorphismRestriction #-}
	import Data.Complex
	import Graphics.UI.SDL as SDL
	(xRes, yRes) = (1366, 768)
	[a, b, k, p] = [0.85, 0.9, 0.4, 7.7]
	main = withInit [InitVideo] $ do
	w <- setVideoMode xRes yRes 32 [NoFrame]
	s <- createRGBSurface [] 1 1 32 0 0 0 0
	fillRect s Nothing $ Pixel 0xFFFFFF
	enableEvent SDLMouseMotion False
	setCaption "Ikeda" "Ikeda"
	render w s $ ikeda $ 0 :+ 0
	SDL.flip w
	run w
	run w = do
	e <- pollEvent
	delay 64
	case e of
	KeyUp (Keysym SDLK_ESCAPE _ _) -> return ()
	_ -> run w
	render w s = mapM_ draw
	where
	rect (x,y) = Just $ Rect (round x) (round y) 1 1
	g (x,y) = (x + xRes / 24, y + yRes / 2.25)
	draw z = blitSurface s Nothing w $ rect $ g p
	where
	p = (1050 * realPart z, 1050 * imagPart z)
	ikeda = take 1500000 . filter g . iterate f
	where
	f z = a + b * z * exp(i * (k-p) * (1 + abs z^2))
	i = 0 :+ 1
	g (r:+i) = -35 < r && r < 35 && -18 < i && i < 18

view raw ikeda-map.hs hosted with ❤ by GitHub

hénon attractor

French astronomer Michel Hénon reported on this strange, fractal attractor in 1976. Since then, it has been among the most studied examples of chaotic dynamical systems.

	{-# LANGUAGE NoMonomorphismRestriction #-}
	import Graphics.UI.SDL as SDL
	(xRes, yRes) = (1366, 768)
	(a, b) = (1.4, 0.3)
	main = withInit [InitVideo] $ do
	w <- setVideoMode xRes yRes 32 [NoFrame]
	s <- createRGBSurface [] 1 1 32 0 0 0 0
	fillRect s Nothing $ Pixel 0xFFFFFF
	enableEvent SDLMouseMotion False
	setCaption "Hénon" "Hénon"
	render w s henon
	SDL.flip w
	run w
	run w = do
	e <- pollEvent
	delay 64
	case e of
	KeyUp (Keysym SDLK_ESCAPE _ _) -> return ()
	_ -> run w
	render w s = mapM_ draw
	where
	rect (x,y) = Just $ Rect (round x) (round y) 1 1
	g (x,y) = (500*x + xRes / 2, 900*y + yRes / 2)
	draw (x,y) = blitSurface s Nothing w $ rect $ g (x,y)
	henon = take 99999 $ filter g $ iterate f (0,0)
	where
	f (x,y) = (1 - a*x^2 + y, b*x)
	g (x,y) = -1.5 < x && x < 1.5 && -0.45 < y && y < 0.45

view raw michel_henon.hs hosted with ❤ by GitHub