The system seems to give interesting results only when b is close to one. It behaves less chaotically when b > 1 is fixed, so you can actually animate it - click the thumbnail to see.
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.
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.
For a round of code golf, I wrote this spare implementation of Chris Langton's remarkably simple universal computer. If you want amenities like pause, random starting pattern or even quit, check out this more complete version.
Like Barry Martin's 'Hopalong' fractal, this dynamical system from John Connett was first published in Scientific American in 1986. This demo is interactive: successively clicking two points specifies a rectangle to zoom into. Doing so, you'll see that the system isn't actually a fractal. Instead of self-similarity, deep zooms reveal peacock-like images.
This pattern generator, discovered by Barry Martin, was nicknamed 'Hopalong' when Scientific American introduced it in their September '86 issue.Clicking the window adjusts the viewport position; there is also an alternate version with color and animation.
Also, for a certain Rubyist friend, I wrote another lazily-evaluated, colored and animated implementation in Ruby.
It took me some experimentation to figure out how to color this derivation of the logistic map; I'm still not quite sure how the hues should scale as you zoom. But the bi-tonal method shown below works well enough to produce the image at left - click it for more detail.
What programmer hasn't at some point written an implementation of Benoit Mandelbrot's great discovery, the most famous fractal in the world? Here's my own minimal version, with the simplest possible coloring scheme. To interact with it, just click any two points: the window will zoom in on the rectangle they define.
This code renders any of the 2187 possible 3-colored, 1-dimensional, totalistic cellular automata. I was charmed by these and many other beautiful demonstrations in Stephen Wolfram's notorious compendium, though I regret I can't say the same for its tendentious style.
The program input is an integer representing the intended CA rule in base 3.
This code takes the rule number for an elementary cellular automaton as input, and then runs the CA from a random seed, rendering the result. The seed comprises 600 random bits taken from rule 30. Its length, when accounting for scale, is greater than the window width; this helps keep pathological edge effects outside the visible frame. The screenshot at left shows an execution of the famous rule 110.
For my own conviction, it was enough to find that the expression sum (take 80 $ rands 5000) `div` 80 produces 2525.
Since each random bit requires computing a full cell generation, this algorithm quickly slows down. I assume more pragmatic implementations solve this by perhaps re-seeding the automaton after some number of iterations.
An array representation on the other hand, grows proportionally with the area spanned by all live cells. Since random patterns quite often fire gliders in opposite directions, this area can grow very quickly.
Anyway, this program takes a .cells pattern file for an optional argument; you can also press 'r' while paused for a random pattern, or click to create your own.
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE TupleSections #-}
import Graphics.UI.SDL as SDL
import System.Environment (getArgs)
import Control.Arrow ((***))
import Control.Monad (liftM2, join)
import Data.List (delete, unfoldr)
import System.Random.Mersenne.Pure64 (newPureMT, randomInt)
import qualified "hashmap" Data.HashSet as S
import qualified "unordered-containers" Data.HashMap.Strict as M
(xres, yres, cellSz) = (1600, 900, 3)
main = withInit [InitVideo] $ do
win <- setVideoMode xres yres 32 [Fullscreen]
args <- getArgs
pat <- case args of
[s] -> loadPattern s
_ -> return []
enableEvent SDLMouseMotion False
setCaption "Life" "Life"
pause win pat
pause w cs = do
delay 128
drawCells w cs
e <- pollEvent
case e of
KeyUp (Keysym SDLK_ESCAPE _ _) -> return ()
KeyUp (Keysym SDLK_SPACE _ _) -> run w cs
KeyUp (Keysym SDLK_r _ _) -> pause w =<< randPattern
MouseButtonUp x y _ -> click (scale x, scale y)
_ -> pause w cs
where
scale = (`div` cellSz) . fromIntegral
click c | c `elem` cs = pause w $ delete c cs
| otherwise = pause w $ c:cs
run w cs = do
drawCells w cs
e <- pollEvent
case e of
KeyUp (Keysym SDLK_ESCAPE _ _) -> return ()
KeyUp (Keysym SDLK_SPACE _ _) -> pause w cs
_ -> run w $ next cs
drawCells w cs = do
fillRect w (Just $ Rect 0 0 xres yres) (Pixel 0)
c <- createRGBSurface [SWSurface] cellSz cellSz 32 0 0 0 0
mapM_ (draw c . scale) cs
SDL.flip w
where
rect (x,y) = Just $ Rect x y cellSz cellSz
scale = join (***) (* cellSz)
draw c p = do fillRect c Nothing $ Pixel 0xFFFFFF
blitSurface c Nothing w $ rect p
----------------------------------------------------------------
loadPattern = fmap parse . readFile -- reads .cells format
where
parse = center . clean . coord . strip . lines
strip = dropWhile $ (== '!') . head
coord = zipWith zip $ map (zip [0..] . repeat) [0..]
clean = concatMap $ map fst . filter ((== 'O') . snd)
randPattern = fmap f newPureMT
where
f = center . uncurry zip . splitAt 48 . g
g = map (`rem` 9) . unfoldr (Just . randomInt)
center = map $ (x+) *** (+y)
where
[x,y] = map (`div` (2 * cellSz)) [xres, yres]
next cs = [i | (i,n) <- M.toList neighbors,
n == 3 || (n == 2 && S.member i cs')]
where
cs' = S.fromList cs
moore (x,y) = tail $ liftM2 (,) [x, x+1, x-1] [y, y+1, y-1]
neighbors = M.fromListWith (+) $ map (,1) $ moore =<< cs
import Data.Bits (shift)
import Data.List (unfoldr)
import Control.Arrow ((***))
import Control.Monad (when, join)
import Data.Set (insert, delete, member, empty, fromList, toList)
import Graphics.UI.SDL as SDL
import System.Random.Mersenne.Pure64 (newPureMT, randomInt)
(xres, yres, sq, cast) = (1600, 900, 3, fromIntegral)
origin = (xres `div` 2 `div` sq, yres `div` 2 `div` sq)
main = withInit [InitVideo] $ do
w <- setVideoMode xres yres 32 [NoFrame]
enableEvent SDLMouseMotion False
setCaption "Langton's Ant" "Langton's Ant"
pause w origin (0,1) empty
pause w p v ps = do
delay 128
e <- pollEvent
case e of
KeyUp (Keysym SDLK_ESCAPE _ _) -> return ()
KeyUp (Keysym SDLK_SPACE _ _) -> run w [1..] p v ps
KeyUp (Keysym SDLK_r _ _) -> randomize
_ -> pause w p v ps
where
randomize = do
ps <- randPattern
render w ps
pause w origin (0,1) ps
run w (n:ns) p v ps = do
when (n `mod` 7 == 0) $ render w ps
e <- pollEvent
case e of
KeyUp (Keysym SDLK_ESCAPE _ _) -> print n
KeyUp (Keysym SDLK_SPACE _ _) -> pause w p v ps
_ -> continue
where
continue = run w ns (move p $ g v) (g v) $ f p ps
b = member p ps
f = if b then delete else insert
g = if b then fl else fr
move (x,y) = (x+) *** (+y)
fr (x,y) = if x == 0 then (-y,x) else (y,x)
fl (x,y) = if x == 0 then (y,x) else (y,-x)
render w ps = do
fillRect w (Just $ Rect 0 0 xres yres) $ Pixel 0
mapM_ (draw w . join (***) (* sq)) $ toList ps
SDL.flip w
draw w p = f p =<< g [SWSurface] sq sq 32 0 0 0 0
where
rect x y = Just $ Rect x y sq sq
g = createRGBSurface
f (x,y) s = do fillRect s (rect 0 0) $ Pixel $ rgb x y
blitSurface s (rect 0 0) w $ rect x y
randPattern = fmap (fromList . f) newPureMT
where
f = center . uncurry zip . splitAt 11000 . g
g = map (`rem` 512) . unfoldr (Just . randomInt)
center = map $ (x+) *** (+y)
where
[x,y] = map (`div` (2 * sq)) [xres, yres]
rgb x y = shift r 16 + shift g 8 + 128
where
r = round $ (cast x / cast xres) * 255
g = round $ (cast y / cast yres) * 255