Brian’s (Purely) Functional Brain « It Seemed Like a Good Idea at the Time

14Oct/0919

Brian’s (Purely) Functional Brain

So about a week ago I came across an interesting post in which the author implemented the Brian's Brain cellular automaton in 67 lines of Clojure. Not about to let my favorite language be outdone, I thought I'd see how well Haskell would do with the same task.

Then I was kept horribly busy for a week by schoolwork, so a couple of days ago I started playing around with the problem. The results? Not too shabby!

So first of all, we'll be needing some imports. Since (for some odd reason) Haskell requires all imports up front, and since this blog post is supposed to be Literate Haskell, you'll have to just trust me that we'll need these for now:

> import Data.Array -- Used to store the world state for processing
> import System.Random -- Used to generate the initial random world
> import Control.Monad -- Used for some fancy looping constructs
> import Control.Concurrent -- Used to fork the quit event handler
> import Graphics.UI.SDL as SDL -- Used to draw the pretty pictures
> import Control.Parallel.Strategies

Cells can be either On, Dying, or Off:

> data Cell = Off | Dying | On deriving (Eq, Enum)

For convenience, let's define some constants:

> worldX = 90 -- The horizontal size of the world
> worldY = 90 -- The vertical size of the world
> cellSize = 8 -- The overall size of a cell
> border = 1 -- The border width between cells
> screenX = worldX * cellSize -- The horizontal size of the world, in pixels
> screenY = worldY * cellSize -- The vertical size of the world, in pixels
> fillSize = cellSize - border -- The size of the filled area in each cell

Cells progress from On to Dying to Off, and they turn on only when they have exactly two live neighbors.

> stepCell (On, _) = Dying -- Live cells always start to die
> stepCell (Dying, _) = Off -- Dying cells always turn off
> stepCell (Off, 2) = On -- If a dead cell has 2 live neighbors, turn on
> stepCell (Off, _) = Off -- Otherwise, just stay turned off

Since we know from the rules that we'll need the ability to count a cell's live neighbors, let's get that out of the way next.

> getPeers world (x,y) = (world ! (x,y), length . filter (== On) $ neighbors)
> where neighbors = [getCell x y | x <- [x-1 .. x+1], y <- [y-1 .. y+1]]
> getCell x y = world ! (clip worldX x, clip worldY y)
> clip max val | val < 1 = clip max $ val + max - 1
> | val > max = clip max $ val - max + 1
> | otherwise = val

So now we have all the pieces to progress from one world state to the next. For each position in the array, we need to look up all its neighbors, count the live ones, and then pass that data to the stepCell function. The helper function indexArray creates an array of cell indices. We map over this array to generate new values for each cell.

The `using` parArr rwhnf is some Haskell magic which causes the array to be evaluated in parallel:

> indexArray x y = listArray ((1,1),(x,y)) [(a,b) | a <- [1..x], b <- [1..y]]
> stepWorld w = newWorld `using` parArr rwhnf
> where newWorld = fmap (stepCell . getPeers w) $ indexArray worldX worldY

Now we have all we need to run a simulation, but it's not quite enough if you insist on getting some pretty pictures. For my fancy display purposes, I happen to like SDL.

The main function initializes SDL, generates a random initial state, produces an infinite list of future world states from that, and then draws each of the states in turn:

> main = do rng <- newStdGen
> SDL.init [SDL.InitVideo]
> SDL.setCaption "Brian's Purely Functional Brain" "Brian's Brain"
> surface <- SDL.setVideoMode screenX screenY 24 [SDL.DoubleBuf]
> forkIO . forever $ waitEvent >>= \e -> when (e == Quit) quit
> mapM (drawWorld surface) (iterate stepWorld $ world rng)
> where world = listArray ((1,1),(worldX,worldY)) . map toEnum . randomRs (0,2)

And our world drawing function is positively boring. We map over each combination of X and Y values, draw each one, and then flip the resulting image on-screen:

> drawWorld s w = do sequence [draw x y | x <- [1..worldX], y <- [1..worldY]]
> SDL.flip s
> where draw x y = SDL.fillRect s (Just rect) . color $ w ! (x,y)
> where rect = SDL.Rect (scale x) (scale y) fillSize fillSize
> scale n = (n - 1) * cellSize
> color On = SDL.Pixel 0x00FFFFFF
> color Dying = SDL.Pixel 0x00888888
> color Off = SDL.Pixel 0x00000000

To take full advantage of the parallelism in this program, you'll need to compile with the threaded runtime and run it on multiple OS threads.

ghc -O3 -threaded --make BriansBrain.hs
./BriansBrain +RTS -N2

And then just sit back and watch the mesmerising patterns.

This code is available on Hackage and GitHub.

Pretty Colors

Tagged as: anythingyoucandohaskellcandobetter, brians brain, haskell Leave a comment

Comments (19) Trackbacks (1) ( subscribe to comments on this post )

Joe Fredette
October 15th, 2009 - 11:36

34LOC, by my count, we win!
Will Donnelly
October 15th, 2009 - 11:43

No need to cheat with our counting methods! The original post clearly counted blank lines and import statements in that 67-line count, so it’s only fair that we do the same. Of course, at 49 LOC, we still win!
Joe Fredette
October 15th, 2009 - 12:39

Fair enough. So long as we’re both kicking pure Java’s ass, we’re good.
Sebastian
October 15th, 2009 - 13:08

Why do you need the indexArray?

Could you not do something like this to compute the new world without the intermediate array?

array (bounds w) [ ((x,y), stepCell (getPeers w (x,y)) | x <- [1..worldX], y <- [1..worldY] ] `using` parArr rnf

Also, that "clip" function looks an awful lot like mod (with tweaking)…
Will Donnelly
October 15th, 2009 - 14:34

Sebastian:

I could have computed the whole thing in one go, but notice that your proposed function is 113 characters, and I limited every line of my code to 80 characters (otherwise it would be too easy to cheat the line counts).

If I wanted to do everything at once, I would probably use do notation rather than a large comprehension like that, but that would add two extra lines to the code.

And yes, ‘clip’ is equivalent to ‘mod’ for positive arguments (with an offset of one, but that’s easy), but ‘mod’ on a negative argument is still negative, so it wouldn’t work for my purposes.
Austin King
October 15th, 2009 - 15:29

One of the points of Literate Programing is to free you of listing your imports first. You don’t have to do that… Mention them when they are useful in your prose and then tangle them into the top of the source file.
Will Donnelly
October 15th, 2009 - 15:37

Austin:

It really would be nice to do that, but Literate Haskell still requires all imports to be at the top of the file. Despite the names, Literate Haskell isn’t quite the same as Literate Programming.
Nathan
October 15th, 2009 - 17:07

Haskell programmers don’t win, programmers win by using Haskell.
Sebastian
October 15th, 2009 - 17:12

Nothing stopping you from breaking a line in two just because it’s one expression. Or naming the list comprehension in a where clause or something. It just seems odd to take that roundabout way via the index array.
drhodes
October 15th, 2009 - 17:47

save 2 lines by reducing worldX and worldY to just worldSize. Same for screenX&Y and assume a square world.
Will Donnelly
October 15th, 2009 - 18:31

drhodes:

There’s good reason for having independent sizes on the different axes: with a perfectly square world you can end up with two gliders remaining, and the two will never collide, but with some properly selected sizing that can be made impossible.

Sebastian:

You may be right. I think the list comprehension was actually left over from an earlier iteration wherein I needed a similar comprehension multiple times, and I just never really looked at
changing it because it wouldn’t have altered the line count, and seems plenty clear to me.
drhodes
October 15th, 2009 - 22:25

RE: square world, Oh! I suppose the symmetry has something to do with it. I’m having a great time reading this program. It integrate many different aspects: SDL, Concurrency, Random, Monads and Strategies all at once. Thanks for taking the time to post, it helps.
silver
October 16th, 2009 - 15:44

Sorry for offtopic, but can you share your haskell-mode? I like your colors :>
Michael Schade
October 16th, 2009 - 17:43

Very nicely done. It has me interested in Haskell now (don’t let Python know), that’s for sure.
Stephen Mann
February 15th, 2010 - 18:57

Great job on the awesome program!

That’s a beautiful screenshot. How did you manage the screenshot — getting gvim and a terminal running side-by-side like that? I first thought screen with regions, but then you wouldn’t get the colors. Then I thought emacs in viper-mode, but then you wouldn’t get the ~’s down the left side.

I’m looking around for a good haskell IDE, so this question is about more than simple aesthetics.
Will Donnelly
February 15th, 2010 - 20:38

I’m not running gvim, I’m running vim with the csapprox plugin to support 256-color themes, and xmonad handles tiling the three xterms for me.

I’ve found that setup tends to be the best for my development workflow. I keep the source code I’m currently working on in the left half of the screen, and then the right side is given over to any other tools I happen to need.
Stephen Mann
February 15th, 2010 - 23:51

I hadn’t come across xmonad before. It looks awesome! Thanks for sharing.

I’ve been using this (http://stephenmann.net/2009/11/24/vim-is-my-grails-ide/) trick to interact with the terminal from gvim. It’s a rip off Jonathan Palardy’s SLIME trick (http://technotales.wordpress.com/2007/10/03/like-slime-for-vim/).

I’ve recently been looking into emacs, looking for better editor/terminal interaction than a screen hack. But I’ve been using vi so long, I don’t know if I can (or really want) to make the switch.

Maybe xmonad will make switching apps so fast, it won’t matter that there’s no direct interaction.
Noah Easterly
June 4th, 2010 - 15:12

I think your implementation of clip has some bugs:

clip max val | val max = clip max $ val - max + 1
| otherwise = val

-- so case by case
clip max (-1) = max - 2
clip max 0 = max - 1
clip max 1 = 1
clip max 2 = 2
-- ...
clip max (max-1) = max - 1
clip max max = max
clip max (max + 1) = 2
clip max (max + 2) = 3

So when we wraparound to the nonpositive, we never get a value of max, and when we wrap around past max, we never get a value of 1.

Fixing it is pretty easy though:

clip max val | val max = clip max $ val - max
| otherwise = val

-- so case by case
clip max (-1) = max - 1
clip max 0 = max
clip max 1 = 1
clip max 2 = 2
-- ...
clip max (max-1) = max - 1
clip max max = max
clip max (max + 1) = 1
clip max (max + 2) = 2
Noah Easterly
June 4th, 2010 - 15:14

I think your implementation of clip has some bugs:

> clip max val | val
> | val > max = clip max $ val - max + 1
> | otherwise = val
>
> -- so case by case
> clip max (-1) = max - 2
> clip max 0 = max - 1
> clip max 1 = 1
> clip max 2 = 2
> -- ...
> clip max (max-1) = max - 1
> clip max max = max
> clip max (max + 1) = 2
> clip max (max + 2) = 3
>

So when we wraparound to the nonpositive, we never get a value of max, and when we wrap around past max, we never get a value of 1.

Fixing it is pretty easy though:

> clip max val | val
> | val > max = clip max $ val - max
> | otherwise = val
>
> -- so case by case
> clip max (-1) = max - 1
> clip max 0 = max
> clip max 1 = 1
> clip max 2 = 2
> -- ...
> clip max (max-1) = max - 1
> clip max max = max
> clip max (max + 1) = 1
> clip max (max + 2) = 2
>