Posts Tagged ‘automata’

Programming Praxis – Rule 30 RNG

April 29, 2011

In today’s Programming Praxis exercise, our goal is to write a random number generator based on the Rule 30 cellular automaton. Let’s get started, shall we?

Some imports:

import Control.Monad.State
import Data.Bits
import Data.Word

First we define the amount of bits in our RNG state.

size :: Int
size = 7 * 43

We’re going to be needing a function to convert a list of bits to a number.

fromBits :: (Bits a, Integral a) => [Bool] -> a
fromBits = foldl (\a x -> shift a 1 .|. fromIntegral (fromEnum x)) 0

The step function replaces the state with the next generation of cells for a given rule and returns the middle bit.

step :: Monad m => Int -> StateT Integer m Bool
step r = modify (\s -> let b i = testBit s (mod i size) in
    fromBits [ testBit r $ fromBits [b (n+1), b n, b (n - 1)]
             | n <- [size - 1, size - 2..0]]) >> gets (`testBit` div size 2)

To produce a random number, we take the middle bit of the desired number of generations and convert that to an unsigned integer.

randomBits :: Monad m => Int -> Int -> StateT Integer m Word
randomBits n r = return . fromBits =<< replicateM n (step r)

To test the algorithm, we see if we get the correct result when we only set the bit in the middle. Afterwards, we produce a bunch of 8-bit numbers.

main :: IO ()
main = evalStateT (do r <- randomBits 32 30
                      liftIO $ print (r == 3112904540)
                      liftIO . print =<< replicateM 100 (randomBits 8 30)
                  ) $ bit (div size 2)

Looks like everything is working properly.

Advertisements

Programming Praxis – Conway’s game of life

May 11, 2010

With the author of Programming Praxis currently hospitalized, I’ll be posting some programming exercises in his stead until he’s recovered.

Conway’s game of life is the most well-known example of cellular automata. It consists of a 2D grid where each cell is either alive or dead. Alive cells stay alive if they have 2 or 3 alive neighbors, otherwise they die. Dead cells become alive when they have 3 alive neighbors. Other rule variations exist, but Conway’s version is the most commonly used one. These simple rules result in a lot of complexity. In fact, the game of life is equivalent to a universal Turing machine.

Theoretically, Conway’s game of life takes place on an infinite grid, but for practical reasons the size of the grid is often limited, with cells beyond the edges being assumed dead.

In today’s exercise, your task is to write an algorithm that takes a starting situation and can produce an arbitrary number of subsequent generations. When you are finished, you are welcome to read a suggested solution below, or to post your own solution or discuss the exercise in the comments below (to post code, put it between [code][/code] tags).

 
 

First, some imports.

import Data.List.Split
import qualified Data.Map as M

Cells stay/become alive if they have 3 neighbors, or 2 if they’re already alive. Anything else dies.

rule :: (Num a) => Char -> a -> Bool
rule c n = c == 'x' && n == 2 || n == 3

Since the algorithm needs to check a cell’s neighbors, we need to know what they are.

neighbours :: (Int, Int) -> [(Int, Int)]
neighbours (y,x) = [(y', x') | y' <- [y-1..y+1], x' <- [x-1..x+1],
                               (y', x') /= (y, x)]

We will need a way to load the starting situation.

load :: String -> M.Map (Int, Int) Char
load = M.fromList . concat . zipWith (\y -> zipWith (\x c ->
           ((y, x), c)) [1..]) [1..] . lines

To obtain the next generation, we just apply the rule to every cell.

next :: M.Map (Int, Int) Char -> M.Map (Int, Int) Char
next b = M.mapWithKey (\k a -> if rule a . length .
             filter (\p -> M.findWithDefault '.' p b == 'x') $
             neighbours k then 'x' else '.') b

Next, we need a function to show a generation in a more readable format.

display :: M.Map (Int, Int) Char -> String
display b = unlines . chunk (snd . fst $ M.findMax b) $ M.elems b

And, finally, something to show multiple subsequent generations.

run :: Int -> M.Map (Int, Int) Char -> IO ()
run n = mapM_ (putStrLn . display) . take n . iterate next

Let’s test to see if everything’s working correctly.

main :: IO ()
main = run 10 $ load ".........\n\
                     \.xx......\n\
                     \.xx..xxx.\n\
                     \.....x...\n\
                     \......x..\n\
                     \..x......\n\
                     \..x......\n\
                     \..x......"

If you implemented everything correctly, the last generation should look like this:

.....xx..
....x..x.
.....xx..
.........
..xx.....
.x..x....
.x.x.....
..x......

Programming Praxis – Cellular Automata

May 15, 2009

Today’s Programming Praxis problem is about cellular automata. Let’s dive in.

As usual, our imports:

import Data.Bits
import Data.List

Programming Praxis’ author uses ones and zeros to represent on and off cells. That works, but you run the risk of accidentally having another number somewhere and crashing your program. We Haskell programmers like our type safety, so we’re going to use booleans. First we need a function to get the successor of a group of cells:

successor :: Int -> [Bool] -> Bool
successor r bs = testBit r . sum $
                 zipWith (shiftL . fromEnum) (reverse bs) [0..]

Using that, we can generate the next row as follows:

nextRow :: Int -> [Bool] -> [Bool]
nextRow r xs = map (successor r) . take (length xs) . transpose .
               take 3 . iterate (drop 1) $ [head xs] ++ xs ++ [last xs]

Since lists of booleans are not that easy to read, let’s use spaces and Xs.

displayRow :: [Bool] -> String
displayRow = intersperse ' ' . map (\b -> if b then 'X' else ' ')

Each run starts with one active cell and simply consists of repeating nextRow as often as needed.

cells :: Int -> Int -> [String]
cells r h = map displayRow . take (h + 1) . iterate (nextRow r) $
            replicate h False ++ [True] ++ replicate h False

And finally we test out program. Let’s make a lovely Sierpinski triangle:

main :: IO ()
main = mapM_ putStrLn $ cells 82 15

Done. 10 lines of code. Not bad.