Programming Praxis – A Dozen Lines Of Code

In today’s Programming Praxis exercise, our goal is to make any program we want, as long as it’s cool and it fits within 12 lines of code. I decided to make an implementation of Conway’s Game of Life: it’s interesting, it’s visual, it’s Turing complete… how much cooler can you get? Let’s get started, shall we?

First, some imports. I’m not counting these as lines of code since to me a line of code is something that can contain a bug.

import qualified Data.List.Key as K
import qualified Data.Map as M

First we define the rule that the game of life is based on: cells stay alive if they have 2 or 3 neighbors, and they become alive if they have 3 neighbors.

rule (cy,cx) m = elem ns $ if alive (cy,cx) then [2,3] else [3] where
    ns = sum [1 | y <- [-1..1], x <- [-1..1], (y,x) /= (0,0), alive (cy+y,cx+x)]
    alive c = M.lookup c m == Just 'x'

We calculate the next generation of a grid by determining the rectangle that holds the active cells, adding a one-cell border (since that’s the furthest influence distance) and calculating the new state for each cell in the resulting rectangle.

step m = if null on then M.empty else M.fromList
    [((y,x),if rule (y,x) m then 'x' else '.') | y <- range fst, x <- range snd]
    where on = M.keys $ M.filter (== 'x') m
          range f = [minimum (map f on) - 1..maximum (map f on) + 1]

Next, we need some functions to load and show a generation:

load s = M.fromList [((y,x),c) | (y,l)<-zip [0..] $ lines s, (x,c)<-zip [0..] l]

display = mapM_ (putStrLn . map snd) . ([]   . K.group (fst . fst) . M.assocs

The program reads the input from a text file that holds the starting situation, e.g.

.....
.xxx.
.x...
..x..
.....

and then prints all of the subsequent generations until the pattern stabilizes, i.e. it finds two subsequent identical generations.

main = mapM_ (display . snd) . takeWhile (uncurry (/=)) .
    (\l -> zip l $ tail l) . iterate step . load =<< readFile "life.txt"

And that’s it. A cool little program that’s even one line under our budget of 12.

Programming Praxis – McNugget Numbers

In today’s Programming Praxis exercise, our goal is to determine all the numbers that are not McNugget numbers, i.e. numbers that cannot be created by summing multiples of 6, 9 and 20. Let’s get started, shall we?

A quick import:

import Data.List

The code is pretty straightforward: just take all the numbers up to 180 that cannot be created by a linear combination of 6, 9 and 20.

notMcNuggets :: [Integer]
notMcNuggets = [1..180] \\
    [a+b+c | a <- [0,6..180], b <- [0,9..180-a], c <- [0,20..180-a-b]]

To test whether everything works correctly:

main :: IO ()
main = print notMcNuggets

Yup. Nice and simple.

Programming Praxis – Pascal’s Triangle

In today’s Programming Praxis our task is to neatly display Pascal’s triangle. Let’s get started, shall we?

A quick import to making printing slightly more convenient:

import Text.Printf

Calculating Pascal’s triangle is trivial:

pascal :: [[Integer]]
pascal = iterate (\prev -> 1 : zipWith (+) prev (tail prev) ++ [1]) [1]

To display the triangle correctly, we need to prepend the appropriate amount of spacing to each line based on the longest (i.e. last) line.

prettyPascal :: Int -> IO ()
prettyPascal n = mapM_ (\r -> printf "%*s\n" (div (longest + length r) 2) r) rows
    where rows = map (unwords . map show) $ take (n + 1) pascal
          longest = length $ last rows

An that’s all there is to it. A quick test to see if everything is working proprely:

main :: IO ()
main = prettyPascal 10

Programming Praxis – Brainfuck

In today’s Programming Praxis exercise, our goal is to implement a Brainfuck interpreter. Let’s get started, shall we?

Since we’ll be doing a lot of moving left and right in the program and cells a zipper is an obvious data structure to use.

import Data.List.Zipper

Running a program is a simple matter of executing all the steps until we arrive at the end, starting with a zeroed-out list.

run :: String -> IO String
run = fmap toList . flip step (fromList $ replicate 30000 '\NUL') . fromList

step :: Zipper Char -> Zipper Char -> IO (Zipper Char)
step prog s = if endp prog then return s else
              uncurry step =<< instruction (cursor prog) prog s

Using the zipper, most of the instructions are fairly trivial. The brackets are the only ones that require a bit of extra work.

instruction :: Char -> Zipper Char -> Zipper Char -> IO (Zipper Char, Zipper Char)
instruction '<' prog s = return (right prog, left s)
instruction '>' prog s = return (right prog, right s)
instruction '+' prog s = return (right prog, replace (succ $ cursor s) s)
instruction '-' prog s = return (right prog, replace (pred $ cursor s) s)
instruction '.' prog s = putStr [cursor s] >> return (right prog, s)
instruction ',' prog s = fmap ((,) (right prog) . flip replace s) getChar
instruction '[' prog s = return $ (if cursor s == '\NUL' then
                             right $ move right '[' ']' prog else right prog, s)
instruction ']' prog s = return (move left ']' '[' prog, s)
instruction _   prog s = return (right prog, s)

Moving the cursor to the corresponding bracket requires stepping over any nested sets of brackets.

move :: (Zipper Char -> Zipper Char) -> Char -> Char -> Zipper Char -> Zipper Char
move dir open close = f 0 . dir where
    f 0 z | cursor z == close = z
    f n z = f (if cursor z == open  then n + 1 else
               if cursor z == close then n - 1 else n) $ dir z

All that's left to do is to run the program, which prints the expected Hello World message.

main :: IO ()
main = run "++++++++++[>+++++++>++++++++++>+++>+<\
 \<<<-]>++.>+.+++++++..+++.>++.<<++++++\
 \+++++++++.>.+++.------.--------.>+.>." >> return ()

Programming Praxis – Tetrahedral Numbers

In today’s Programming Praxis, our goal is to find the base of the three-sided pyramid that has 169179692512835000 spheres in it. Let’s get started, shall we?

A quick import:

import Data.List

The tetrahedral numbers are based on the triangular numbers, so let’s start with those.

triangular :: [Integer]
triangular = scanl1 (+) [1..]

The tetrahedral numbers are formed in much the same way as the triangular ones.

tetrahedral :: [Integer]
tetrahedral = scanl1 (+) triangular

All that’s left to do is to is to find the base of the pyramid.

main :: IO ()
main = print . maybe 0 succ $
       findIndex (== 169179692512835000) tetrahedral

Programming Praxis – First Non-Repeating Character

In today’s Programming Praxis exercise, our goal is to find the first character in a string that does not occur anywhere else in the string. Let’s get started, shall we?

Some imports:

import Data.List
import qualified Data.Map as M

To find the first non-repeated element, we mark each element as unique and insert them into a map. When a duplicate element is found, we remove its unique status. Afterwards, we search the list for the first unique element.

firstUnique :: Ord a => [a] -> Maybe a
firstUnique xs = find (M.fromListWith (\_ _ -> False)
                           (zip xs $ repeat True) M.!) xs

Some tests to see if everything is working properly:

main :: IO ()
main = do print $ firstUnique "aabcbcdeef"   == Just 'd'
          print $ firstUnique "aabcbcfeed"   == Just 'f'
          print $ firstUnique "aabcbcdeefdf" == Nothing

Programming Praxis – Hett’s Problem 1.28

In today’s Programming Praxis, our goal is to sort a list of lists by length and by length frequency. Let’s get started, shall we?

A quick import:

import qualified Data.List.Key as K

Sorting by length is trivial.

byLength :: [[a]] -> [[a]]
byLength = K.sort length

Sorting by frequency of the list lengths is a bit more complicated since we need to group and ungroup the lists, but still a one-liner.

byLengthFreq :: [[a]] -> [[a]]
byLengthFreq = concat . byLength . K.group length . byLength

Some tests to see if everything is working properly:

main :: IO ()
main = do print $ byLength ["abc","de","fgh","de","ijkl","mn","o"]
                        == ["o","de","de","mn","abc","fgh","ijkl"]
          print $ byLengthFreq ["abc","de","fgh","de","ijkl","mn","o"]
                            == ["o","ijkl","abc","fgh","de","de","mn"]

End of an Era

Last tuesday I got my PhD. Unfortunately, that has some consequences for this blog. Since I’ll now be working at a real job, which I’m starting monday, I won’t be able to do any Programming Praxis exercises during working hours anymore like I have for the past couple years. I’ll try and do some in the evenings now and then, but since I have a lot of other stuff to do, the frequency will be significantly reduced.

I hope you guys have enjoyed this blog over the past few years and I hope I’ve gotten at least a few of you to try out Haskell. If you haven’t, what are you waiting for? Go download the Haskell Platform and get started! Looking for something to practise on? Go do some of the exercises from Programming Praxis. I’m looking forward to reading your solutions.

Regards,
Remco Niemeijer

Programming Praxis – Feet And Inches

In today’s Programming Praxis exercise, our goal is to convert a decimal length value to the fractions used by carpenters. Let’s get started, shall we?

Some imports:

import Data.Ratio
import Text.Printf

To get proper rounding we first multiply by 32 and then see how many feet, inches and fractions of an inch there are.

toCarpenter :: RealFrac a => a -> (Int, Int, Ratio Int)
toCarpenter l = (feet, div r 32, mod r 32 % 32) where
    (feet, r) = divMod (round $ l * 32) (32 * 12)

Formatting the text is a unfortunately a tad unwieldy due to the number of special cases.

feetAndInches :: RealFrac a => a -> String
feetAndInches l = case toCarpenter l of
    (0,0,0) -> "0 feet 0 inches"
    (f,i,t) -> showUnit "foot" "feet" (f % 1) ++
               (if f > 0 && (i%1 + t) > 0 then " " else "") ++
               showUnit "inch" "inches" (i % 1 + t)
    where
    showUnit _ _ 0 = ""
    showUnit s m n = printf "%s %s" (showVal n) $ if n <= 1 then s else m
    showVal v | d == 1    = show n
              | v < 1     = printf "%d/%d" n d
              | otherwise = printf "%d and %d/%d" (div n d) (mod n d) d
              where (n,d) = (numerator v, denominator v)

Some tests to see if everything is working properly:

main :: IO ()
main = do print $ feetAndInches 0       == "0 feet 0 inches"
          print $ feetAndInches 0.2785  == "9/32 inch"
          print $ feetAndInches 1.6895  == "1 and 11/16 inches"
          print $ feetAndInches 11.9999 == "1 foot"
          print $ feetAndInches 12.2785 == "1 foot 9/32 inch"
          print $ feetAndInches 71.9999 == "6 feet"
          print $ feetAndInches 72      == "6 feet"
          print $ feetAndInches 72.3492 == "6 feet 11/32 inch"
          print $ feetAndInches 72.9999 == "6 feet 1 inch"
          print $ feetAndInches 73      == "6 feet 1 inch"
          print $ feetAndInches 73.0135 == "6 feet 1 inch"
          print $ feetAndInches 73.0185 == "6 feet 1 and 1/32 inches"
          print $ feetAndInches 73.8218 == "6 feet 1 and 13/16 inches"

Programming Praxis – Thank God It’s Friday!

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