Archive of published articles on May, 2009

Back home

Huffman Coding

31/05/2009

This is the second of probably three posts (the first was on run-length encoding in Haskell) inspired by Thomas Guest’s interesting article on the Deflate algorithm. This is also my first post in literate haskell. Please post any improvements to the code if you have them!

For a refreshingly readable introduction to Huffman Coding and the Deflate algorithm, have a look at this short explanation by Antaeus Feldspar.


First some boilerplate...

> module Huffman
>     where
>
> import Data.List (sort, insert)
> import qualified Data.Map as M
> import Data.Function (on)
> import Control.Arrow (second)

We make an abstract datatype for binary digits. I wonder if this would
be a nice (but slow?) way of working with binary IO. There doesn't seem
to be a package on Hackage for this

> data Bit = O | I
>            deriving (ShowOrdEq)

we define a simple binary tree useful for decoding the encoded binary
stream. the simple algorithm for assigning codes to our symbols
produces this tree. A completed tree for some text containing only
three letter might look like this:

     0    /\    1
         /\ A  
        C  B

> data HTree a = Branch {zer :: (HTree a), one :: (HTree a),
>                        wt  :: Int }
>              | Leaf {symb :: a,  wt :: Int }
>               deriving (Show)

maps from <Symbol> to <Binary Code>, we create this from the HTree
built from the list of weighted symbols. the HTree can't be used for
encoding.

> type CodeDict a = M.Map a [Bit]

Now some instance declarations so that we know how to order (by weight):

> instance Ord (HTree a) where
>     compare = compare `on` wt
>
> instance Eq (HTree a) where
>     (=== (==`on` wt


our function for merging two branches which we use to build the HTree
from the list of symbols and their corresponding weights. no point in
defining a Monoid instance, but we'll tip our hat to it:

> mappend t1 t2 = Branch t1 t2 (wt t1 + wt t2)


BULDING THE CODING TREES


    
We assign codes to our weighted symbols using a simple algorithm
which takes the trees (initially Leaves) with the lowest weights
and combines them (and their weights) and inserts them back into
the list until they have been combined into a single tree:

> buildDecTree :: [(a,Int)] -> HTree a
> buildDecTree = build . sort . map (uncurry Leaf)
>     where build (t:[])     = t
>           build (t1:t2:ts) = build $ insert (t1 `mappend` t2) ts


now convert the binary tree representation to a dictionary form for
encoding. we decompose the tree into a list from the top down, mapping
either a 1 or 0 over the flattened children. a little confusing:

> buildEncDict :: (Ord a) => HTree a -> CodeDict a
> buildEncDict = M.fromList . build 
>     where build (Leaf t _)     = (t,[]) : []
>           build (Branch a b _) = mapBit O a ++ mapBit I b
>            -- build up the codes in the snd of each Leaf's tuple:
>           mapBit b = map (second (b:)) . build


(EN/DE)CODING FUNCTIONS



To encode a list of symbols for which we've generated an HTree, we just
map over it, looking up it's code in our Map dictionary:

> encode :: (Ord a) => CodeDict a -> [a] -> [Bit]
> encode d = concatMap (d M.!)


To decode we simply read a Bit at a time from the input, at the same time
traversing the HTree (going left when we encounter a zero, and vice versa).
When we hit a Leaf (the end of a code) we return the symbol and go onto
the next bit from the top of the HTree once again.

> decode :: HTree a -> [Bit] -> [a]
> decode t [] = []
> decode t bs = dec bs t
>     where dec bs' (Leaf x _) = x : decode t bs'
>           dec (O:bs') (Branch l _ _) = dec bs' l 
>           dec (I:bs') (Branch _ r _) = dec bs' r 



UPDATE: I scrapped and re-did this section. Should be a little better now.:


USAGE EXAMPLES



I realize I need a more compelling example and some explanation. First,
imagine we want to encode into binary the following phrase:

> phrase = "twenty bytes of text"

we could represent it in ASCII but that would be wasteful of space, using
a whole byte per character when we are using only ten of the 256 possible
codes in the ASCII character set.

So we generate a list of the characters to encode along with their
frequencies (symbols with higher frequencies will be given shorter
prefix codes, saving space!):

> huffmanTree' = buildDecTree [('t',5),('e',3),('y',2),('w',1),('n',1),
>                              ('b',1),('s',1),('o',1),('f',1),('x',1),
>                              (' ',3)]

...and encode it using the dictionary built from the code tree we just
built:

> encodedPhrase = let dict = buildEncDict huffmanTree'
>                  in encode dict phrase

This yields the following binary stream of 8 bits (vs. 20 if we had used
ASCII encoding):

[I,O,O,O,I,O,I,I, O,O,O,I,I,I,O,O, I,O,I,I,I,O,O,O, O,O,I,O,I,O,I,I,
 O,O,O,O,I,I,I,I, O,I,I,I,O,O,I,I, I,I,I,I,I,I,O,I, I,O,O,I,I,O,I,O]

Of course we have to encode instructions to build our tree along with the
above message.

7 Comments

Run-length Encoding

26/05/2009

Just a quick implementation of a RLE algorithm for lists in haskell. We compress a list by converting “runs” of consecutive elements into a tuple of the form: (run_length, element).


import Data.List (group)
import Control.Arrow


runLengthEnc :: Eq a => [a] -> [(Int,a)]
runLengthEnc = map (length &&& head. group

decode :: [(Int, a)] -> [a]
decode = concatMap (uncurry replicate)

If the &&& combinator looks foreign to you, check out David R. Maciver’s very enlightening blog about Arrow functions.

I’m always curious to see how naive-looking functions like the above compare in performance to a from-scratch implementation with explicit recursion, so I came up with the following:


runLengthEnc' :: Eq a => [a] -> [(Int,a)]
runLengthEnc' [] = []
runLengthEnc' (a:as) = run 1 a as
    where run n x [] = [(n,x)]
          run n x (x2:xss) | x == x2   = run (n+1) x xss
                           | otherwise = (n,x) : run 1 x2 xss

I tested both functions on a list of 100,000 random 1s and 0s and found the explicit version to be only marginally better performing, completing the list in 49 ticks & 130Mb, compared to 54 ticks & 139 Mb for the one-liner!

2 Comments

Partial Application and a simple Mastermind game

17/05/2009

I thought this was a good, simple example of how currying and partial application can be used in a very expressive way. We create a one-liner to play the game mastermind.

In the type signature we include unnecessary parentheses, to be clear that we are thinking of the function not as “a function taking a secret code and a guess and returning a score for the guess” but as “a function taking a secret code and returning a scoring function for that code”.


module MasterMind
    where

-- the score is returned as ( x_correct_out_of , y_total)
score :: Eq a => [a] -> ([a] -> (Int,Int))
score c = flip (,) (length c) . length . filter id . zipWith (==) c


game = score [4,3,5,0]

No Comments