huffman.hs

module Main where

import Data.List

data Ord a => Tree a = Node a (Tree a) (Tree a) | Leaf a
	deriving (Eq)
val (Node a _ _) = a
val (Leaf a) = a

instance (Show a, Ord a) => Show (Tree a) where
	show (Node x l r) = "(" ++ show x ++ " " ++ show l ++ " " ++ show r ++ ")"
	show (Leaf x) = show x
--	showsPrec _ (Leaf x) = shows x
--	showsPrec _ (Node x l r) = ('(':) . shows x . (' ':) . shows l . (' ':) . shows r . (')':)

instance Ord a => Ord (Tree a) where
	compare = compare `on` val

findmax (x1 : x2 : xs) = findmax' (max x1 x2) (min x1 x2) xs
findmax' m1 m2 [] = ([], (m1, m2))
findmax' m1 m2 (x : xs) = if x > m1
	then comb m2 $ findmax' x m1 xs
	else if x > m2
		then comb m2 $ findmax' m1 x xs
		else comb x $ findmax' m1 m2 xs
	where
		comb x (xs, z) = (x : xs, z)

pass xs = Node (val x + val y) x y : xs' where
	(xs', (x, y)) = findmax xs

comp [x] = [x]
comp l = comp $ pass l

huffman = head . comp . map Leaf