[Haskell-cafe] Huffman Codes in Haskell

[ajb at spamcop.net]

G'day all.

Quoting Andrew Coppin <andrewcoppin at btinternet.com>:

> What the...?
>
> Oh, I see. It uses another package to handle the tricky sorting and
> searching stuff. Well, yeah, that would make the code a bit shorter...
> ;-)
>
> Even so, it's not nearly as elegant to behold as, say, the quicksort
> algorithm, despite being of roughly similar complexity. Still, it's
> shorter than what I had.

Ah, but the famous Haskell quicksort algorithm is optimised for brevity.
It's an executable specification of quicksort, not a practical sort
algorithm.

But honestly, it's just not that hard to do in linear time, assuming
the symbols are sorted by frequency:

data HuffmanTree a = Empty
                    | Node (HuffmanTree a) (HuffmanTree a)
                    | Leaf a
   deriving Show

huffmanTree :: (Ord w, Num w) => [(w,a)] -> HuffmanTree a
huffmanTree
   = build . map (id &&& Leaf) . sortBy (comparing fst)
   where
     build [] = Empty
     build [(_,t)] = t
     build ((w1,t1):(w2,t2):wts)
       = build $ insertBy (comparing fst) (w1+w2, Node t1 t2) wts

Now if you want a real challenge, implement length-limited Huffman
codes.  Here's a suggested interface:

-- There really should be a better traits typeclass for bit hackery,
-- but there isn't.
class (Integral w, Bits w) => WordType w where { wordBits :: w -> Int }
instance WordType Word8 where { wordBits = 8 }
instance WordType Word16 where { wordBits = 16 }
instance WordType Word32 where { wordBits = 32 }
instance WordType Word64 where { wordBits = 64 }

minimalRedundancyCode :: (Ord w, Num w, WordType word) =>
         [(w,a)] -> [(a,Int,word)]
-- minimalRedundancyCode returns an optimal prefix-free minimal-redundancy
-- code such that every code fits in a word of size w. An entry (a,b,w)
-- in the result means that the code for a is stored in the b least
-- significant bits of w.

Andrew Bromage