ramanujan's Π summation

When G.H. Hardy first began his correspondence with Srinivasa Ramanujan, he was amazed by the prodigy's elegant and surprising series for irrational and transcendental values. Although Ramanujan hadn't included proofs of the theorems, Hardy told his colleagues, "they must be true, because, if they were not true, no one would have the imagination to invent them."

For example, here's Ramanujan's sum for Π which, after just 3 terms, overwhelms IEEE 754 double precision. Modern discoveries, like spigot algorithms on non-decimal bases, can find a given individual digit in constant time. But for fully expanding Π, no one has surpassed Ramanujan's expression: both the Chudnovsky brothers and Yasumasa Kanada adapted it to achieve their milestone calculations.

	import Prelude hiding (pi)
	pi = recip . sum $ map f [0..2]
	f k = a * (b / c)
	where
	a = (2 * sqrt 2) / 9801
	b = fac (4 * k) * (1103 + 26390 * k)
	c = fac k**4 * (396**(4 * k))
	fac n = product [1..n]

view raw ramanujan_PI.hs hosted with ❤ by GitHub

generalizing langton's ant

Christopher Langton's ant can be generalized by adding states to the ant, producing automata known as turmites. Shown here is the behavior of one interesting two-state turmite, started on an empty plane. Click the thumbnail to see more generations; you'll see that this turmite always produces a framed square with the same distinctive irregular pattern.

	import Control.Arrow ((***))
	import Control.Monad (join, void, when)
	import Data.Set (delete, empty, insert, member, toList)
	import Graphics.UI.SDL as SDL
	(xres, yres, sq) = (1600, 900, 2)
	main = withInit [InitVideo] $ do
	w <- setVideoMode xres yres 32 [NoFrame]
	enableEvent SDLMouseMotion False
	setCaption "Turmite" "Turmite"
	run w [1..] 0 p (0,1) empty
	where
	p = (xres `div` 2 `div` sq, yres `div` 2 `div` sq)
	run w (n:ns) s p v ps = do
	when (n `mod` 23 == 0) $ render w ps
	e <- pollEvent
	case e of
	KeyUp (Keysym SDLK_ESCAPE _ _) -> print n >> printout
	KeyUp (Keysym SDLK_SPACE _ _) -> pause w s p v ps
	_ -> continue
	where
	continue = go w ns s p v ps
	printout = void $ saveBMP w "output.bmp"
	pause w s p v ps = do
	delay 128
	e <- pollEvent
	case e of
	KeyUp (Keysym SDLK_ESCAPE _ _) -> return ()
	KeyUp (Keysym SDLK_SPACE _ _) -> run w [1..] s p v ps
	_ -> pause w s p v ps
	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 0xFFFFFF
	blitSurface s (rect 0 0) w $ rect x y
	go w ns s p v ps
	| s == 0 && not b = run w ns 0 (f p $ l' v) (l' v) qs
	| s == 0 && True = run w ns 1 (f p $ r' v) (r' v) qs
	| s == 1 && not b = run w ns 0 (f p $ r' v) (r' v) rs
	| otherwise = run w ns 1 (f p $ l' v) (l' v) rs
	where
	b = member p ps
	(qs, rs) = (insert p ps, delete p ps)
	f (x, y) = (x +) *** (+ y)
	r' (0, y) = (-y, 0)
	r' (x, y) = ( y, x)
	l' (0, y) = ( y, 0)
	l' (x, y) = ( y, -x)

view raw langton_turmite.hs hosted with ❤ by GitHub