Archive for August, 2010


August 13, 2010

I’m away on conference/vacation for the next six weeks, so I’ll be back at the start of October. In the meantime, if you’ve not already done so, why not go and learn Haskell yourself? Real World Haskell is a good way to get started.

Happy Haskell hacking holidays!

Programming Praxis – E

August 13, 2010

In today’s Programming Praxis exercise our task is to determine how many random numbers between 0 and 1 we have to sum on average to exceed 1. Let’s get started, shall we?

Some imports:

import Control.Monad
import System.Random

First, the algorithm itself, which counts the number of required additions.

f :: Float -> IO Int
f s = if s > 1 then return 0 else fmap succ . f . (s +) =<< randomRIO (0, 1)

To get an average, we run the algorithm a number of times and take the average.

test :: Int -> IO Float
test n = fmap ((/ toEnum n) . toEnum . sum) $ replicateM n (f 0)

As usual, a test to see if everything works:

main :: IO ()
main = print =<< test 100000

Three sequential test produce 2.72085, 2.71691 and 2.71838. Certainly in the right ballpark of the expected result of e, with the last one accurate to three places behind the comma, so it looks like everything’s okay.

Programming Praxis – Literate Programming

August 10, 2010

In today’s Programming Praxis exercise, our task is to write a program that converts K&R-style literate code to the resulting code listing. Let’s get started, shall we?

Some needed imports:

import Control.Applicative hiding (many, (<|>))
import Text.Parsec

The provided Scheme solution uses regular expressions. We will be using a parser-based approach instead. The idea is to store all the definitions in a list so we can then go in and make all the required substitutions. A definition can contain two types of lines: regular code or references to other definitions, in which case we also store the preceding indentation.

data Lit = Line String | Ref String String

The parser for this file format isn’t too complicated.

def = (,) <$> (many literate *> chunk <* char '=' <* literate)
          <*> sepEndBy1 line newline where
    rol = many (noneOf "\n")
    upto end = manyTill anyChar (try $ end)
    chunk = string "<<" *> many space *> upto (many space *> string ">>")
    literate = notFollowedBy chunk *> rol <* newline
    line = try (Ref <$> many space <*> chunk <* rol)
           <|> (Line <$> many1 (noneOf "\n"))

As mentioned earlier, the program parses all the definitions, stores them in a list and recursively substitutes all the references with their content.

tangle :: String -> String
tangle src = maybe "" (unlines . (f =<<)) $ lookup "*" defs where
    defs = either (error . show) id $ parse (many def) "" src
    f (Line s)  = [s]
    f (Ref n s) = map (n ++) . maybe [] (f =<<) $ lookup s defs

Let’s see if everything works:

main :: IO ()
main = putStrLn . tangle =<< readFile "tangle.txt"

Yep. Alternatively, just use a language with built-in literate programming, like Haskell 🙂

Programming Praxis – Carl Hewitt’s Same-Fringe Problem

August 3, 2010

In today’s Programming Praxis exercise we have to implement Carl Hewitt’s same-fringe algorithm, which determines if two binary trees have the same leaves in the same order, regardless if their respective structures. The simple solution of flattening both trees and comparing them doesn’t work in most languages, since their strict evaluation requires that the entire flattened list be loaded into memory, which will fail on big trees. Haskell on the other hand is lazy by default, so we don’t need to do anything complicated to have things work correctly. Let’s get started, shall we?

Since we’ll be working with binary trees, we’ll need to define a data structure for them:

data Tree a = Node (Tree a) (Tree a) | Leaf a

Flattening a tree is trivial.

flatten :: Tree a -> [a]
flatten (Node l r) = flatten l ++ flatten r
flatten (Leaf x)   = [x]

As mentioned in the intro, all we need to do is check whether the two flattened lists are equal.

sameFringe :: Eq a => Tree a -> Tree a -> Bool
sameFringe a b = flatten a == flatten b

As always, a test to see if things are working correctly:

main :: IO ()
main = print $ sameFringe (Node (Leaf 1) (Node (Leaf 2) (Leaf 3)))
                          (Node (Node (Leaf 1) (Leaf 2)) (Leaf 3))

Looks like they are. But how do we prove this method doesn’t require a big memory overhead? Well, let’s just create some big trees and find out. A binary tree of depth 28 has 2^28 = over 268 million leaves. At the very least, that would result in a list of 1 GB, and that’s assuming 32 bits per integer and no overhead. Since Haskell’s default lists are linked lists, you should probably at least double that. However, the following program

main = print $ sameFringe (treeOfDepth 28 (Leaf 1))
                          (treeOfDepth 28 (Leaf 1))
       where treeOfDepth n t = iterate (\x -> Node x x) t !! (n - 1)

hums along at a constant memory use of less than 20 MB when interpreted and less than 3 MB when compiled, the compiled version finishing in just under 32 seconds. To quote Larry Kersten, “Hard work often pays off after time, but laziness always pays off now.” 🙂