本着霍夫曼编码的精神，即最优无损编码，这里是我在 Haskell 中能想到的最短的霍夫曼编码生成实现。其函数签名为：
huffman :: Eq a => [(a, Int)] -> [(a, String)]
其中参数是一个 (元素, 频率) 对的列表。它返回一个 (元素, 二进制编码) 的列表。
v1
这需要以下导入：
-- 导入
import Data.List (sortBy)
import Data.Ord (comparing)
以下是主程序：
data Tree a = Leaf a Int | Node Int (Tree a) (Tree a) deriving (Show)
freq (Leaf _ f) = f
freq (Node f _ _) = f
merge t1 t2 = Node (freq t1 + freq t2) t1 t2
decode t x = (x, decode' "" t)
where
decode' acc (Leaf y _) = if x == y then reverse acc else ""
decode' acc (Node _ l r) = (decode' ('0':acc) l) ++ (decode' ('1':acc) r)
combine [x] = x
combine xs = let (t1:t2:rest) = sortBy (comparing freq) xs in combine ((merge t1 t2):rest)
huffman xs = map ((decode (combine (map (uncurry Leaf) xs))) . fst) xs
由于我们在每次迭代时都进行排序，而优先队列就足够了，因此这个实现并不最优。我只是不想使用外部库。
如果我们完全忽略可读性，并去掉泛型类型 a：
huffman :: [(Char, Int)] -> [(Char, String)]
287 字节：
data T=L Char Int|N Int T T
f(L _ w)=w;f(N w _ _)=w
m t1 t2=N(f t1+f t2)t1 t2
d t x=(x,s"" t)where s a(L y _)=if x==y then reverse a else"";s a(N _ l r)=s('0':a)l++s('1':a)r
c[x]=x;c x=let(t1:t2:r)=sortBy(\a b->f a`compare`f b)x in c(m t1 t2:r)
huffman x=map((d(c(map(uncurry L)x))).fst)x
v2
data T=L Char|N T T
huffman x=[(c,e t c"")|(c,_)<-x]where
t=f$foldr ins[][(n,L c)|(c,n)<-x]
f[(n,t)]=t
f((n1,t1):(n2,t2):l)=f$ins(n1+n2,N t1 t2)l
ins n[]=[n]
ins n l@(n':ls)|fst n<=fst n'=n:l|1>0=n':ins n ls
e(L c)c' s=if c==c' then s else""
e(N l r)c s=e l c(s++"0")++e r c(s++"1")