[Haskell-cafe] Re: Huffman Codes in Haskell

[Bertram Felgenhauer]

Andrew Bromage wrote:
> > But honestly, it's just not that hard to do in linear time, assuming
> > the symbols are sorted by frequency:
> 
> Or maybe not so easy.

But not much harder.

data Tree a = Branch (Tree a) (Tree a)
            | Leaf   a
    deriving Show

huffmanTree :: (Ord a, Num a) => [(a, b)] -> Tree b
huffmanTree [] = error "huffmanTree: empty code"
huffmanTree xs =
    let xs' = sortBy (comparing fst) [(a, Leaf b) | (a, b) <- xs]
        branches ((a, l) : (b, r) : ts) = (a+b, Branch l r) : branches ts
        merged = merge (-1 :: Int) xs' (branches merged)
        merge n []     ys          = take n ys
        merge n (x:xs) ys | n <= 0 = x : merge (n+1) xs ys
        merge n (x:xs) (y:ys) = case comparing fst x y of
            GT -> y : merge (n-1) (x:xs) ys
            _  -> x : merge (n+1) xs (y:ys)
    in  snd $ last merged

regards,

Bertram