> 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 (Show, Ord, Eq)

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)

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

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

> phrase = "twenty bytes of text"

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

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

[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]