Posts Tagged ‘conway’

Programming Praxis – Thank God It’s Friday!

June 24, 2011

In today’s Programming Praxis exercise, our goal is to implement three functions related to dates: two ways to calculate the day of the week for a given date and one to calculate the ‘doomsday’ of a given year. Let’s get started, shall we?

To make the results a bit easier to work with we make a data type with the days of the week.

data Weekday = Sun | Mon | Tue | Wed | Thu | Fri | Sat deriving (Enum, Eq, Show)

The algorithms are just a bit a math.

gauss :: Int -> Int -> Int -> Weekday
gauss y m d = toEnum $ mod (d + floor (2.6 * fromIntegral
  (mod (m - 2) 12) - 0.2) + y' + div y' 4 + div c 4 - 2*c) 7 where
    (c,y') = divMod (if m < 3 then y - 1 else y) 100

sakamoto :: Int -> Int -> Int -> Weekday
sakamoto y m d = toEnum $ mod (y + div y 4 - div y 100 +
    div y 400 + [0,3,2,5,0,3,5,1,4,6,2,4] !! (m - 1) + d) 7

conway :: Int -> Weekday
conway y = toEnum $ mod (q + r + div r 4 + 5*(c+1) + div c 4 + 4) 7
    where (c, (q,r)) = (div y 100, divMod (mod y 100) 12)

Some tests to see if everything is working properly:

main :: IO ()
main = do print $ gauss 2011 6 24 == Fri
          print $ sakamoto 2011 6 24 == Fri
          print $ conway 2011 == Mon

Programming Praxis – Look And Say, Revisited

March 28, 2011

In today’s Programming Praxis exercise, our goal is to calculate Conway’s constant. Let’s get started, shall we?

First we need to represent the polynomial that we’re going to take the root of.

conway :: Num a => a -> a
conway x = sum $ zipWith (*) (iterate (* x) 1)
    [ -6,  3,-6, 12,-4, 7,-7, 1, 0, 5,-2, -4,-12, 2, 7,12,-7,-10
    , -4,  3, 9, -7, 0,-8,14,-3, 9, 2,-3,-10, -2,-6, 1,10,-3,  1
    ,  7, -7, 7,-12,-5, 8, 6,10,-8,-8,-7, -3,  9, 1, 6, 6,-2, -3
    ,-10, -2, 3,  5, 2,-1,-1,-1,-1,-1, 1,  2,  2,-1,-2,-1, 0,  1]

Next, we calculate the root by halving the interval until the value at the middle is sufficiently close to 0.

root :: (Fractional a, Ord a) => (a -> a) -> a -> a -> a -> a
root f lo hi e | abs (f mid) < e = mid
               | f mid > 0       = root f lo mid e
               | otherwise       = root f mid hi e
               where mid = (lo + hi) / 2

Since we know the root lies somewhere between 1 and 2, we use those as the starting values.

main :: IO ()
main = print $ root conway 1 2 1e-7 == 1.303577269034296

We get the correct answer, so everything seems to be working properly.

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......