Archive for June, 2010

Programming Praxis – World Cup Prognostication

June 29, 2010

In today’s Programming Praxis exercise, the goal is to write a simulator for the knockout stage of the World Cup. Let’s get started, shall we?

We’re going to be using a language pragma that I’ll get back to later. Also, some imports.

{-# LANGUAGE BangPatterns #-}

import Control.Monad
import qualified Data.List.Key as K
import qualified Data.Map as M
import System.Random

First, we define the teams and their elo ratings.

teams :: [(String, Float)]
teams = [ ("URU", 1890), ("KOR", 1746), ("USA", 1785), ("GHA", 1711)
        , ("NED", 2045), ("SVK", 1654), ("BRA", 2082), ("CHI", 1883)
        , ("ARG", 1966), ("MEX", 1873), ("GER", 1930), ("ENG", 1945)
        , ("PAR", 1771), ("JPN", 1744), ("ESP", 2061), ("POR", 1874)]

The formulas for determining which team is more likely to win and calculating the new elo rating after a match:

winChance :: Float -> Float -> Float
winChance eloA eloB = 1 / (1 + 10 ** ((eloB - eloA) / 400))

update :: Float -> Float -> Float
update winner loser = winner + 60 * (1 - winChance winner loser)

Match determines the winner of a match given a random number.

match :: Float -> (a, Float) -> (a, Float) -> (a, Float)
match r (a, ea) (b, eb) | r < winChance ea eb = (a, update ea eb)
                        | otherwise           = (b, update eb ea)

A round consists of playing a match for each pair of teams.

simround :: [(a, Float)] -> [Float] -> [(a, Float)]
simround (a:b:xs) (r:rs) = match r a b : simround xs rs
simround _        _      = []

And a tournament is nothing more than a series of successive rounds until there is only one team left.

tournament :: [(a, Float)] -> IO a
tournament [(w,_)] = return w
tournament xs      = tournament . simround xs . randoms =<< newStdGen

And when simulating, we run the desired number of tournaments, keeping a count of the winners. Note the bang pattern in the first argument of foldM, which prevents the stack from exploding. This way, the map gets updated after each tournament instead of ending up with a thunk of a million nested updates.

simulate :: Int -> IO ()
simulate n = print . K.sort (negate . snd) . M.assocs =<<
    foldM (\ !m _ -> fmap (\x -> M.adjust succ x m) $ tournament teams)
          ( (const 0) $ M.fromList teams) [1..n]

As usual, a test to if everything works:

main :: IO ()
main = simulate 1000000

Here is a sample simulation, which shows Brazil edging out Spain for first place, just like in the Scheme solution.


Programming Praxis – Learn A New Language

June 25, 2010

The goal in today’s Programming Praxis exercise is to solve a previous exercise in a language you’re not proficient in. Since I’m a big fan of statically typed languages, I figured I’d try a dynamically typed one today, the two most obvious options being Python and Ruby. I’ve done a little Python coding (among others, it’s the scripting language for the text editor I use). Of the two, Ruby has always seemed the more interesting one (partly because it embraces functional programming more than Python does), but I haven’t yet had occasion to use it. Let’s remedy that.

As for the exercise, I picked Steve Yegge’s Phone-Screen Coding Exercises, figuring seven different small problems might cover slightly more ground than one bigger one.

Reversing a string works just like in Haskell, save for the fact that we have to explicitly convert the string to a character array.

def reverse(s)
    s.chars.inject {|rev, x| x + rev }

For calculating Fibonacci numbers we can’t use the typical Haskell solution of zipping an infinite sequence with itself, so instead we just use a fold, keeping a buffer of the last two values calculated.

def fib(n)
    (2..n).inject([0,1]) {|fs, i| [fs[1], fs[0] + fs[1]]} [[1, n].min]

For the 12 times table, the solution is basically the same as the Haskell one, though since Ruby has no list comprehensions we have to use a nested map.

def timestable
    (1..12).map {|r| puts (1..12).map {|c| "%4d" % (r * c)}.join}

Summing numbers from a file is straightforward: read the lines of the file, convert them to numbers and sum them up, same as in Haskell.

def sum_from_file(file) {|f|}

Printing the odd numbers from 1 to 99 is trivial as well.

def odd_numbers
    p (1..99).find_all(&:odd?)

Getting the highest integer in a list can be done with a simple fold.

def maximum(array)
    array.inject {|max, i| i > max ? i : max}

Again, identical to the Haskell version, if a bit longer due to the lack of partial application.

def to_rgb(r, g, b)
    sprintf("%02x%02x%02x", r, g, b)

As usual, our tests:

puts reverse("Hello, World!")
p (0..10).map {|x| fib x}
puts sum_from_file("numbers.txt")
puts maximum([-1,3,2])
puts to_rgb(255, 128, 65)

Naturally, a test this short is hardly conclusive evidence, but so far Ruby doesn’t disappoint. All seven functions are one-liners, as you would expect from any competent language, though this is slightly marred by the need for end keywords. I prefer the Haskell and Python approach in this, since it eliminates these useless almost-empty lines. On the plus side, first-class functions and all the common enumerable methods mean you can often directly transcribe the Haskell solution, which is nice. It won’t be replacing Haskell as my favorite language any time soon, but out of the more mainstream languages you could do a lot worse than Ruby.

Programming Praxis – Matrix Operations

June 22, 2010

In today’s Programming Praxis exercise our task is to implement four common matrix operations. The provided Scheme solution has 44 lines. Let’s see what we can do to reduce that a bit.

There are many ways to represent matrices. The most common one in Haskell (if not the most efficient if you need random access) is to use a list of lists, which is what we’ll be using here.

For addition, all we need to do is add the corresponding numbers in the two matrices together.

add :: Num a => [[a]] -> [[a]] -> [[a]]
add = zipWith $ zipWith (+)

Scaling (multiplying by a constant) is even simpler: just apply the multiplication to every element.

scale :: Num a => a -> [[a]] -> [[a]]
scale = map . map . (*)

For transposition I could’ve just used the definition from Data.List, but that would be cheating. Instead, I figured I would just use a right fold.

transpose :: [[a]] -> [[a]]
transpose [] = []
transpose xs = foldr (zipWith (:)) (repeat []) xs

Multiplying two matrices requires multiplying rows and columns. Since nested lists don’t have easy access to columns, we can use the transpose function we just defined to fix that.

mult :: Num a => [[a]] -> [[a]] -> [[a]]
mult a b = [map (sum . zipWith (*) r) $ transpose b | r <- a]

And of course we need to test if everything works correctly.

main :: IO ()
main = do let m = [[1..3],[4..6]]
          let n = [[1..4], [2..5], [3..6]]
          print $ add m [[2..4],[3..5]] == [[3,5,7], [7,9,11]]
          print $ scale 2 m == [[2,4,6], [8,10,12]]
          print $ mult m n == [[14,20..32], [32,47..77]]
          print $ transpose m == [[1,4], [2,5], [3,6]]

Yep. And with a 89% reduction in line count, that’s good enough for me.

Programming Praxis – Natural Join

June 15, 2010

In today’s Programming Praxis exercise we have to implement a program that joins two files with tables in them. The provided Scheme solution is 29 lines, so let’s see if we can’t reduce that a little bit.

Some imports:

import Data.List
import Data.List.Split
import System.Environment

The tables are read from files with lines of tab-separated values.

loadFile :: FilePath -> IO [[String]]
loadFile = fmap (map (splitOn "\t") . lines) . readFile

Due to the assumption given in the exercise (the key is always the first field), the join algorithm can be pretty simple. It doesn’t take into account that the keys are sorted, so it’s not as efficient as it could be (O(n^2) versus O(n)), but for the small test case we’re using this doesn’t matter that much.

join :: Eq a => [[a]] -> [[a]] -> [[a]]
join (ks1:f1) (ks2:f2) = union ks1 ks2 :
    [k1 : v1++v2 | (k1:v1) <- f1, (k2:v2) <- f2, k1 == k2]
join _        _        = []

While the exercise only calls for two parameters, this would actually take more code than accepting an arbitrary number of them (>= 2), so we do that instead.

main :: IO ()
main = mapM_ putStrLn . map (intercalate "\t") .
       foldl1 join =<< mapM loadFile =<< getArgs

Six lines, one of which is technically not needed for the test case. Not too shabby.

Programming Praxis – N-Queens

June 11, 2010

In today’s Programming Praxis we have to solve the classic n-queens problem. The provided Scheme solution has 13 lines. Let’s see if we can do any better.

A quick import:

import Data.List

The wikipedia page for the algorithm mentions a simple algorithm where you take the permutations of 1 through n as the column positions for the n consecutive rows and removing the illegal ones. So let’s see if that works.

queens :: Int -> [[Int]]
queens n = filter (safe . zip [1..]) $ permutations [1..n]

Since the algorithm guarantees that no two queens will be on the same row or column, we only need to check the diagonals.

safe :: [(Int, Int)] -> Bool
safe []     = True
safe (x:xs) = all (safe' x) xs && safe xs where
    safe' (x1,y1) (x2,y2) = x1+y1 /= x2+y2 && x1-y1 /= x2-y2

A quick test produces the same results as the Scheme solution, and the correct amount according to Wikipedia. At four lines, that will do nicely (you can make it 3 by expressing safe as safe xs = and . zipWith (all . safe’) xs . tail $ tails xs, but I find that version to be less clear than the current one).

main :: IO ()
main = mapM_ print $ queens 5

Programming Praxis – Diff

June 8, 2010

In today’s Programming Praxis exercise our task is to write a diff command line tool. Let’s get started, shall we?

First, we import a package that gives us a longest common subsequence function.

import Data.List.LCS.HuntSzymanski

There are three possible differences between files: deletions, additions and changes.

data Change = D | A | C

We define a few helper functions for the output: one to display the line numbers in the correct format, one for printing headers and one to show the lines that are different.

linenum :: (Int, Int) -> String
linenum (s, e) = if s == e then show s else show s ++ "," ++ show e

header :: (Int, Int) -> String -> (Int, Int) -> IO ()
header l op r = putStrLn $ linenum l ++ op ++ linenum r

section :: Char -> [String] -> IO ()
section c = mapM_ (\s -> putStrLn $ c:' ':s)

The diff function follows the same structure as that in the Scheme solution, but with some of the repetition abstracted out.

diff :: String -> String -> IO ()
diff xs ys = f 0 0 (lines xs) (lines ys) where
    f n1 n2 = g where
        g [] b  = change A [] b
        g a  [] = change D a []
        g a  b  = case lcs a b of
            []    -> change C a b
            (d:_) -> case (head a == d, head b == d) of
                (True, True) -> rec 1 1
                (True, _   ) -> change A q1 q2 >> rec len1 len2
                (_   , True) -> change D q1 q2 >> rec len1 len2
                _            -> change C q1 q2 >> rec len1 len2
                where [q1, q2] = map (takeWhile (/= d)) [a, b]
                      [len1, len2] = map length [q1, q2]
                      rec l r = f (n1+l) (n2+r) (drop l a) (drop r b)

        change D a _ = header (n1+1, n1+length a) "d" (n2, n2) >>
                       section '<' a
        change A _ b = header (n1, n1) "a" (n2+1, n2 + length b) >>
                       section '>' b
        change C a b = header (n1+1, n1+length a) "c" (n2+1, n2+length b) >>
                       section '<' a >> putStrLn "---" >> section '>' b

To test our function, just load two files and diff them.

main :: IO ()
main = do f1 <- readFile "file1.txt"
          f2 <- readFile "file2.txt"
          diff f1 f2

Sadly, this version isn’t all that much shorter than the Scheme version (about a third). There is still a small amount of duplicated code, but I don’t see a way of elegantly factoring it out.

Programming Praxis – Unwrapping A Spiral

June 1, 2010

In today’s Programming Praxis exercise our task is to write a function that walks a 2-dimensional array in a spiral pattern and returns the elements it finds. The provided Scheme solution accomplishes this in 8 lines. Let’s see if we can do any better.

First, a quick import:

import Data.List

The Scheme solution works by having an x and y coordinate and changing them as appropriate. We’re going to take a different approach based on recursion. The easiest way to get the spiral is to remove the first row, rotate the array counterclockwise, and repeat. Rotating the array in this manner can be done by reversing all the rows and then transposing the array.

spiral :: [[a]] -> [a]
spiral []     = []
spiral (x:xs) = x ++ spiral (transpose $ map reverse xs)

Let’s see if this approach works correctly.

main :: IO ()
main = do print $ spiral [[1..4],[5..8],[9..12], [13..16],[17..20]]
            == [1,2,3,4,8,12,16,20,19,18,17,13,9,5,6,7,11,15,14,10]

Yup. And at a mere two lines I’d say that’s not half bad.