Dans l’esprit des codes de Huffman, c’est-à-dire un encodage optimal sans perte, voici la plus courte implémentation de génération de codes de Huffman que j’ai pu concevoir en Haskell. La signature est
huffman :: Eq a => [(a, Int)] -> [(a, String)]
où l’argument est une liste de paires (élément, fréquence). Elle retourne une liste de paires (élément, encodage binaire).
v1
Cela nécessite ces imports :
-- Imports
import Data.List (sortBy)
import Data.Ord (comparing)
Et voici le programme principal
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
Ce n’est pas optimal car nous trions à chaque itération, alors qu’une file de priorité serait suffisante. Je ne voulais simplement pas utiliser de bibliothèques externes.
Si nous oublions complètement la lisibilité et supprimons le type générique a :
huffman :: [(Char, Int)] -> [(Char, String)]
287 octets :
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")