Bonjour à tous !

Ce topic est un peu particulier car je ne suis pas là pour vous décrire un problème et demander des solutions. Je suis là pour vous présenter un de mes codes. Pour ceux qui se feraient la remarque : non, ce post n’as pas non plus sa place dans « Présentation de vos projets », car ce n’est pas vraiment un projet, juste un code sur lequel j’aimerai vous voir réagir. Et par réagir j’entends : essayer de coder un équivalent dans le langage que vous maîtrisez et nous le proposer ici, histoire qu’on compare

Avec ce topic (et probablement d’autres, mais on verra plus tard pour ça) j’espère faire découvrir à certains zéros des langages peu connus ainsi que pointer du doigt les différences entre les langages qui seront présentés. Notament je veux que vous découvriez pourquoi on dit que tel langage est spécialisé dans tel domaine, etc … Je pense que ces constations découleront toutes seules des différents codes qui seront présentés.

Je vous présente donc ici un Codage de Huffman, un algorithme de compression de données inventés en 1952 par la personne qui lui a donné son nom. Bref si vous voulez une description plus complète notamment au niveau de son fonctionnement je vous conseille d’aller sur la page Wikipedia qui y est dédié. J’ai pour ma part implémenté cette algorithme en Scheme , un langage de programmation dérivant du Lisp. Voici mon code :

; Fonction relatives à la création et au tri de la liste
(define (insert tuple lst)
  (cond ((null? lst) (list tuple))
	((char=? (car tuple) (caar lst))
	 (cons (cons (car tuple) (+ (cdr tuple) (cdar lst))) (cdr lst)))
	(else (cons (car lst) (insert tuple (cdr lst))))))

(define (nub lst acc)
  (if (null? lst)
      acc
      (nub (cdr lst) (insert (car lst) acc))))

(define (groupBy elem nb lst acc)
  (cond ((null? lst) (cons (cons elem nb) acc))
        ((char=? elem (car lst)) (groupBy elem (+ nb 1) (cdr lst) acc))
        (else (groupBy (car lst) 1 (cdr lst) (cons (cons elem nb) acc)))))

(define (getMin min lst acc)
  (cond ((null? lst) (cons min acc))
	((< (cdar lst) (cdr min)) (getMin (car lst) (cdr lst) (cons min acc)))
	(else (getMin min (cdr lst) (cons (car lst) acc)))))

(define (sort lst acc)
  (if (null? lst)
      (reverse acc)
      (let ((tuple (getMin (car lst) (cdr lst) '())))
	(sort (cdr tuple) (cons (car tuple) acc)))))

; Fonction amenants à la creation de l'arbre
(define (treeInsert tuple tree)
  (let ((Occ1 (cdr tuple)) (Occ2 0) (elem ()))
    (if (or (null? tree) (null? (cdr tree)))
	(set! Occ2 0)
	(set! Occ2 (cdr tree)))
    (unless (null? tree) (set! elem (car tree)))
    (if (> Occ1 Occ2) 
	(cons (cons (car tuple) elem) (+ Occ1 Occ2))
	(cons (cons elem (car tuple)) (+ Occ1 Occ2)))))

(define (buildHTree lst tree)
  (if (null? lst) 
      (car tree)
      (buildHTree (cdr lst) (treeInsert (car lst) tree))))

; Fonction de création du code et d'encodage
(define (createHCode tree code)
  (cond ((not (pair? tree))
	 (list (cons tree (reverse code))))
	((null? (cdr tree))
	 (list (cons (car tree) (reverse code))))
	(else
	 (let ((gauche (cons #\0 code))
	       (droite (cons #\1 code)))
	   (append (createHCode (car tree) gauche) (createHCode (cdr tree) droite))))))

(define (get letter code)
  (if (char=? letter (caar code))
      (list->string (cdar code))
      (get letter (cdr code))))

(define (encode lst code)
  (for-each (lambda(letter) (display (get letter code))) lst))

; Fonction principale
(define (huff str)
  (let* ((lst (string->list str))
	 (properList (sort (nub (groupBy (car lst) 1 (cdr lst) '()) '()) '()))
         (tree (buildHTree properList '()))
         (code (createHCode tree ())))
    (encode lst code)))

Pour le tester il suffit de le charger dans votre interpreteur Scheme préféré, je vous conseille d’ailleurs DrScheme, et de faire (huff "votre string"). Bref, je vous laisse désormais ma place ! N’hésitez pas à poster vos codes, peu importe le langage, où à poser des questions sur mon code (voir le critiquer ) ou sur l’algorithme lui-même !

Bonne journée.

Bon, un code en haskell, il doit exister bien plus beau :

import Data.Ord
import Data.List
import Data.Maybe
import Control.Arrow

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

makeTree [(poids,x)] = x
makeTree (a:b:xs) = makeTree $ insertBy (comparing fst) (fst a + fst b,Branch (snd a) (snd b)) xs

getCode (Leaf el) = [(el,[])]
getCode (Branch a b) = map (second (False:)) (getCode a) ++ map (second (True:)) (getCode b)

frequences :: (Ord a) => [a] -> [(Int,a)]
frequences = sortBy (comparing fst) . map (length &&& head) . group . sort

transformer code = fromJust . flip lookup code 

coder message = map (\b -> if b then '1' else '0') $ concatMap (transformer code) message
    where code = (getCode . makeTree . map (second Leaf) . frequences) message

Déjà, on importe tout un tas de trucs plus ou moins utiles.

Ensuite, on définit un arbre binaire : c'est soit une feuille, qui contient une valeur, soit une branche, qui contient deux feuilles.

La fonction frequences calcule la fréquence d'apparition de chaque caractère, la fonction makeTree construit l'arbre de Huffman, ensuite on en déduit le codage de chaque élément avec getCode et on transforme un caractère en son codage avec transformer. La fonction coder se charge d'assembler tout ça pour faire un programme potable avec un affichage potable.

Pour faire tourner ça (avec GHC), il faut enregistrer ça dans un fichier (huffman.hs par exemple) et lancer la commande ghci huffman.hs. Ensuite, entrez coder "n'importe quoi", et voilà.

Edit :
Pourquoi haskell c'est bien pour ça ?
Parce qu'on peut définir des types personalisés
La programmation fonctionelle qui aide pas mal à traiter les listes et les arbres
Une bibliothèque standard bien remplie (à relier au point précédent)

Même si l'algorithme de compression de Huffman est l'un des plus esthétique, il en existe d'autres. Ici, un RLE en Forth :

( Run-length encoding -- http://fr.wikipedia.org/wiki/Run-length_encoding )
: foreach   over + swap ;
: init      over c@ 0 2swap ;
: print     . emit ;
: rle       init foreach do over i c@ = if 1+ else print i c@ 1 then loop print ;

mes trois huffmans, C, java, ocaml
http://www.codyx.org/snippet_huffman-a [...] 566.aspx#1791

Merci pour ces 3 versions coucou747 !

lasts : hum, c'est assez impressionant, c'est en tout cas plus court que mes versions Erlang, Scheme, Prolog ... j'essayerai de les retrouver dans la journée pour qu'on compare ! Par contre, c'est peut-être court, mais c'est difficilement compréhensible pour quelqu'un ne connaissant pas ce langage ( c'est mon cas ), donc peut-être pourrais tu nous décrire dans les grandes lignes le fonctionnement de ton code, à l'image de ce qu'a fait gnomnain pour son code Haskell !

En attendant je poste ma version Erlang du codage de Huffman :

-module(huff).
-export([code/1]).

insertElem(Elem, [], Acc) -> [{Elem, 1}|Acc];
insertElem(Elem, [{Elem, Nb}|Tail], Acc) -> Acc ++ [{Elem, (Nb + 1)}|Tail];
insertElem(Elem, [Head|Tail], Acc) -> insertElem(Elem, Tail, [Head|Acc]).

groupBy([], Liste) -> Liste;
groupBy([X|Xs], Liste) -> groupBy(Xs, insertElem(X, Liste, [])).

getMax(Max, [], Rest) -> {Max, Rest};
getMax({A, Nb}, [{X, N}|Xs], Acc) when Nb < N -> getMax({X, N}, Xs, [{A, Nb}|Acc]);
getMax(Max, [X|Xs], Acc) -> getMax(Max, Xs, [X|Acc]).

sort([], Sorted) -> Sorted;
sort([X|Xs], Acc) ->
    {Max, Rest} = getMax(X, Xs, []),
    sort(Rest, [Max|Acc]).

insertBy({Elem, Nb}, {Tree, Occs}) when Nb > Occs -> {{Elem, Tree}, (Nb + Occs)};
insertBy({Elem, Nb}, {Tree, Occs}) -> {{Tree, Elem}, (Nb + Occs)}.

buildTree([], {Tree, _}) -> Tree;
buildTree([X|Xs], Tree) -> buildTree(Xs, insertBy(X, Tree)).

createHCode({Branch1, Branch2}, Code) ->
    Left = ["0"|Code],
    Right = ["1"|Code],
    lists:append(createHCode(Branch1, Left), createHCode(Branch2, Right));
createHCode(Elem, Code) -> [{Elem, lists:reverse(Code)}].

getCode(Letter, [{Letter, Code}|_]) -> Code;
getCode(Letter, [_|Xs]) -> getCode(Letter, Xs).

code(Str) ->
    [X|Xs] = sort(groupBy(Str, []), []),
    Tree = buildTree(Xs, X),
    Code = createHCode(Tree, ""),
    Huffed = lists:map(fun(Letter) -> getCode(Letter, Code) end, Str),
    lists:foreach(fun(A) -> io:format("~s", [A]) end, Huffed), io:nl().

Si quelqu'un a des questions n'hésitez pas !

Et voilà un RLE tout simple, toujours en haskell

import Data.List
import Control.Arrow

rle :: String -> String
rle = concatMap (\(n,e) -> show n ++ [e]) . map (length &&& head) . group

Hum, moi pour le RLE j'ai :

(define (group-by elem nb lst acc)
  (cond ((null? lst) (reverse (cons (cons elem nb) acc)))
        ((char=? elem (car lst)) (group-by elem (+ nb 1) (cdr lst) acc))
        (else (group-by (car lst) 1 (cdr lst) (cons (cons elem nb) acc)))))

(define (rle str)
  (let ((lst (string->list str)))
    (for-each (lambda (tuple) (begin (display (cdr tuple)) (display (car tuple))))
              (group-by (car lst) 1 (cdr lst) '()))))

-module(rle).
-export([compress/1]).

groupBy(Elem, Nb, [Elem|T], Acc) -> groupBy(Elem, (Nb + 1), T, Acc);
groupBy(Elem, Nb, [], Acc) -> lists:reverse([{Elem, (Nb + 1)}|Acc]);
groupBy(Elem, Nb, [X|Xs], Acc) -> groupBy(X, 1, Xs, [{Elem, (Nb + 1)}|Acc]).

show([]) -> io:nl();
show([{Elem, Nb}|Tail]) -> io:format("~p~s", [Nb, [Elem]]), show(Tail).

compress([H|T]) -> show(groupBy(H, 1, T, [])).

Le dernier code est plus intéressant, car il est fait en Prolog, un langage déclaratif. Mais voyez plutôt :

same(X, X).

groupBy(Elem, Nb, [], Acc, Result) :- lists:reverse([{Elem, Nb}|Acc], Result).
groupBy(Elem, Nb, [Elem|Tail], Acc, Result) :-
        NewNb is (Nb + 1),
        groupBy(Elem, NewNb, Tail, Acc, Result).
groupBy(Elem, Nb, [H|T], Acc, Result) :-
        same(NewAcc, [{Elem, Nb}|Acc]),
        groupBy(H, 1, T, NewAcc, Result).

show([]).
show([{Elem, Nb}|Tail]) :- write(Nb), write('-'), write(Elem), nl, show(Tail).

rle([]).
rle([H|T]) :- groupBy(H, 1, T, [], Grouped), show(Grouped).

Pour Huffman j'ai essayé en Python. Je dois dire que Python n'est pas vraiment le langage le plus adapté aux maths, mais bon j'ai fais avec ce que je savais.

#! /usr/bin/env python
# -*- coding: UTF-8 -*-

class TreeElement:
	"Un élément de l'arbre"
	def __init__(self,weight=0,value=None):
		self.weight=weight
		self.value=value
		self.children=[]
		self.parent=None
		self.code=0
	def addChild(self,child):
		"ajouter un enfant augmente automatiquement le poids du parent"
		self.children.append(child)
		self.weight+=child.weight
		child.parent=self
		

def cmpel(e1,e2):
	"Compare le poids de deux éléments d'un arbre pour les trier"
	return e1.weight-e2.weight
def makeList(string):
	"Crée des éléments séparés de l'arbre en leur donnant pour poids leur nombre d'occurence dans la chaîne"
	liste=[]
	while string:
		i=string[0]
		liste.append(TreeElement(string.count(i),i))
		string="".join(string.split(i)) #On supprime toutes les occurences de i dans string
	liste.sort(cmpel)
	return liste
	
def makeTree(liste):
	"Assemble les éléments entre eux dans l'arbre"
	while len(liste)>1:# tant que tous les éléments ne sont pas mis dans l'arbre
		#la liste étant triée selon cmpel (voir makeList), le fait de retirer les 2 premiers éléments équivaut
		#à prendre les 2 éléments de poids le plus faible
		e1=liste.pop(0)
		e1.code=0 # chaque branche se voit attribuer un code, 0 ou 1
		e2=liste.pop(0)
		e2.code=1
		noeud=TreeElement()
		noeud.addChild(e1)
		noeud.addChild(e2)
		liste.append(noeud)
		liste.sort(cmpel)
	return noeud #retourne la racine de l'arbre
	
def makeDictFromTree(root,dico={}):
	"Crée un dictionnaire à partir de l'arbe pour faciliter la compression"
	if root.children: #si l'élément à des enfants
		for i in root.children:
			if i.value:
				dico[i.value]=i
			makeDictFromTree(i,dico)
		
	return dico
def makeCode(string):
	"Fonction qui fait appelle à toutes les fonctions précédentes et retourne un tuple (dico,tree_root)"
	tree_root=makeTree(makeList(string))
	return makeDictFromTree(tree_root),tree_root

def compress(string,dico):
	"""Compresse la chaîne grâce à l'arbre fournit sous forme de dictionnaire.
	Il est possible que la chaîne contiene des caractères supplémentaires si la longueur (en bit) de la chaîne une fois
	assemblées ne forme pas un multiple de 8?
	"""
	newstring=""
	rank=0 #Rank correspond à l'emplacement du bit dans l'octet
	newchar=0 #New char sert à stocker temporairement la valeur du nouveau caractère
	for i in string:
		el=dico[i] #On récupère l'élément correspondant dans l'arbre
		while el.parent: #On remonte l'arbre jusqu'à la racine pour déterminer le code de la lettre
			newchar+=el.code*(2**rank)
			rank+=1
			if rank==8:# on est au bout de l'octet
				newstring+=chr(newchar) #On convertit newchar en caractère
				newchar=0
				rank=0
			el=el.parent
	if newchar!=0: #Si on a pas atteint la fin de l'octet mais qu'il reste un caractère, on le rajoute quand même
		newstring+=chr(newchar)
	return newstring[::-1]
	
def decompress(string,tree_root):
	"Décompresse la chaîne grâce à l'arbre donné, il est possible qu'il faille tronquer la chaîne (voir compress)"
	newstring=""
	rank=0
	element=tree_root
	value=0
	for i in string:
		value=ord(i) #On convertit i en sa valuer ASCII
		for r in range(8): #On lit l'octet bit à bit
			n=value&(2**(7-r))
			element=element.children[n and 1] #Et on descend dans l'arbre pour retrouver l'élément
			if not element.children:
				newstring+=element.value
				element=tree_root
	return newstring[::-1]

s="Hello World ! Ceci est une exemple de compression avec le code de Huffman"
dico,tree_root=makeCode(s)
c=compress(s,dico)
print len(c),len(s)
print decompress(c,tree_root)[0:len(s)] #On tronque la chaîne pour éviter les caractères indésirables

Pour l'utiliser, il faut générer le dico et l'arbre avec makeCode(string) puis pour compresser,compress(string,dico). Pour décompressé, il faut utiliser decompress(string,tree_root). Pour voir simplement le résultat, copiez le code dans un fichier .py et lancez le avec python. Pour voir avec une autre phrase, vous pouvez remplacer la valeur de s dans le fichier.
Je pense que mon code n'est pas super optimisé ni super propre. Le dico sert à faciliter la compression. Pour ceux qui ne connaissent pas python, un dico associe à une clé une valeur. Donc quand je veux avoir l'élément correspondant à la lettre 'a' par exemple, je fais dico['a'].
En tout cas, merci à Dark-Side pour l'idée, je trouve que c'est très intéressant de faire ça.

Une version, normalement un peu moins lente (... que toutes celles proposées pour l'instant), en OCaml :
http://bluestorm.info/ocaml/tmp/huffman_old.ml.html

Cependant, je n'ai pas pu la tester (enfin j'ai fait deux-trois tests vite fait, mais rien de rigoureux), donc je ne garantis pas que le résultat soit juste. C'est la vie.

En parlant de vitesse, je viens de faire des tests, ma version est très très lente. Plusieurs minutes pour compresser un fichier d'environ 3 mo (dont environ 7 secondes pour générer l'arbre) alors que le module zlib de python ne met que quelques secondes à le compresser. Mais bon, mon but était surtout de faire un truc qui marche

Petite mise à jour de l'algo, avec une optimisation pour le cas courant (quand on connaît le nombre maximum de symboles en entrée) :
http://bluestorm.info/ocaml/tmp/huffman.ml.html

Salut à tous,

je prepare quelques versions pour les langages (en l'occurence en D et en C#) que je connais (du moins essaie, moi et l'algo et/ou les maths, ca fait 8 =( ).

Juste une suggestion, je vois pas mal de code plutot cryptiques pour quelqu'un (<=) élevé au bon vieux paradigme objet. Pourriez ajouter, quelques commentaires dans le code, une brève explication de la logique globale de fonctionnement (pas l'algo, mais plutot l'implementation dans le langage en question, comme à fait gnomnain), ainsi que quelques mots sur pourquoi le langage que vous presentez est adapté ou non à ce genre d'algo. De même, si chacun des langages presenté pouvait mettre en avant leurs specifités plutot qu'une quelconque optimisation qui ne montrerait peut etre pas ces points, en gros plus orienté ce comparatif vers un "99 bottles of beers" mais avec des algo variés et reels, que vers un benchmark shootout qui ne montre, bien souvent, aucune des specifités du langage (et puis les concours de grokiki-j'ai-trois-cycles-cpu-de-moins-que-toi-!, on s'en tape un peu, dans les limites du raisonnable bien entendu).

Enfin, m2c. =)

Bon alors, pour revenir sur mon code en Erlang pour le codage de huffman, je vais faire une description dans l’ordre d’execution, alors euh… Tout d’abord on est dans la fonction code, notre première opération est d’appliquer groupBy à la chaîne de caractère Str. Par exemple : groupBy("aaaahhbbb", []) renverra la liste suivante : [{a, 4}, {h, 2}, {b, 3}]. On applique ensuite la fonction sort/2 sur cette liste, on obtient donc la liste [{h, 2}, {b, 3}, {a, 4}]. On se sert ensuite de cette liste pour construire l’arbre.

C’est là qu’intervient buildTree/2, on lui passe en premier argument la queue de la liste précédente et en second argument le premier élément de la liste précédente. Ce dernier va insérer à un à un les éléments de la liste qu’il reçoit en premier argument dans l’arbre, par l’intermédiaire de la fonction insertBy/2. Cette dernière reçoit en premier argument un tuple du type {Element, Nombre} et en second argument un autre tuple dont le membre de gauche est l’arbre et le membre de droite le nombre total d’apparitions des lettres déjà présentes dans l’arbre. Là on regarde si le Nombre > Occs (où Occs est le nombre total d’apparition d… vous avez compris ), si tel est le cas on place notre élément à gauche de notre arbre, et en on renvoie un tuple contenant ce nouvelle arbre et la somme d’Occs et du nombre d’apparition de notre élément.

Une fois notre arbre crée on en déduit le code de huffman, c’est-à-dire une suite de 0 et de 1. Je pense qu’il n’est pas utile de détailler cette partie qui est … triviale Tout se passe dans createHCode. Au final on obtient une liste de tuples qui contiennet un élément et le code qui lui est associé. Par exemple pour notre string "aaaahhbbb" après cette étape on optiendrais : la liste [{h, "00"}, {b, "01"}, {a, "1"}]. Et pour finir on a plus qu’à afficher le résultat !

Bref, pour conclure dans ce code il n’y aucune des particularités d’Erlang de mise en place, du moins, aucune particularité concurrente. C’est un code typiquement fonctionnel.

Sirjulio : Hum, je ne suis pas allé dans ce sens pour la raison suivante : si on en reste à l'algorithme "naïf" (avec des listes), on peut difficilement faire mieux que la version Haskell. Quitte à recoder les fonctions auxiliaires utilisées, on peut faire aussi court, mais ça reviendra toujours à peu près à ça, les langages inspirés ML (Haskell, OCaml, SML...) étant par ailleurs avantagés¹ par leur gestion des types algébriques et du filtrage de motif.

J'ai donc choisi de jouer sur le point faible des implémentations proposées jusqu'alors : elles sont trop naïves. J'ai donc fait une version dans le but de diminuer la complexité algorithmique, au détriment de la concision (j'ai environ 40 lignes pour l'algorithme lui-même, au lieu de la grosse dizaine de l'implémentation tout-liste), et malheureusement un peu de la compréhension (la fonction de construction de l'arbre est "velue").

Voici une analyse rapide des complexités comparées des implémentations présentées (en utilisant le découpage conceptuel de gnomain, qui s'applique toujours) :
- frequences (calcul de la fréquence des symboles de l'entrée) : c'est la fonction la plus lente de toutes les implémentations. Les implémentations de Dark-Side et --alex-- sont quadratiques ( O(n^2) ), celles de coucou747 et gnomain en O(n log n), et la mienne est en O(n log n) ou O(n * c) pour les symboles délimités²
- makeTree (construction de l'arbre) : quadratiques pour toutes les implémentations, linéaire ( O(n) ) pour la mienne; gnomain a une implémentation avec file de priorité en O(n log n), mais il ne l'a pas postée il me semble
- getCode (transcription finale à partir de l'arbre) : O(n * m) où m est le nombre de symboles différents (et n toujours la longueur de l'entrée) pour la plupart des implémentations, O(n * log m) ou O(n) pour les miennes².


¹ : concrètement, l'implémentation en Scheme est franchement douloureuse (caar ?), et l'implémentation Erlang est correcte aux endroits où Erlang met en place un pattern matching du pauvre (pour les listes et les tuples), et plutôt désagréable (par rapport à une version ML) le reste du temps; l'implémentation Python est simplement dégoutante de ce point de vue là, et les implémentations Java et C sont correctes mais très verbeuses.

² : Je donne parfois deux complexités parce que j'ai deux implémentations de frequences et getCode, l'une pour les ensembles de symboles que l'on sait comparer mais dont on ne connaît pas le nombre total au départ (par exemple les entiers), l'autre pour les ensembles "délimités", c'est à dire dont on connaît une taille maximale raisonnable dès le départ, comme les lettres ASCII.

Voici un RLE en Perl (j'ai clarifié le code ).

#!/usr/bin/perl

use strict;
use warnings;

undef $/;
my @tab = split //, <>;
my ($count, $last, $result) = (0, $tab[0], "");

for $ch (@tab) {
  if ($last == $ch) {
    $count++;
  } else {
    $result .= $last . $count;
    $last = $ch;
    $count = 1;
  }
}

print $result, "\n"

Ça lit l'entrée standard jusqu'à EOF (ou le fichier passé en argument), et renvoie le résultat. Il y a sûrement moyen de faire mieux, mais bon .
C'est pas aussi joli comme les solutions fonctionnelles, mais c'est quand même un RLE .

Pour que vous voyiez que j'ai vraiment clarifié, voici le script original :

perl -0777 -le '@t = split //, <>; ($c, $l) = (0, $t[0]); $r = ""; for (@t) {if ($l == $_) {$c++} else {$r .= $l.$c; $l = $_; $c = 1}} print $r'

Le code Erlang est (en dehors de toute consideration technique) plutot elegant à voir, et je suis etonné de la facilité de la maniere qu'ont vos langages à manier les structures de données (qui donne souvent des trucs extremement moche en objet).

Enfin merci pour les precisions. =)

c'est juste different, pas particulierement moche.

enfin faut pas te demander comment tu representerais ces structures dans un langage objet, mais comment tu arriverais au meme resultat.

au final, tu ne codes pas les memes structures (en generale).

Si ça intéresse quelqu'un, une version plus performante sur l'entrée/sortie de mon code :
http://bluestorm.info/ocaml/tmp/huffman2.ml.html

def arbre(liste):
    tree = [liste[0]]
    for lettre, nb in liste[1:]:
        elem = tree.pop()
        if nb > elem[1]:
            tree.append(((elem[0], lettre), elem[1]+nb))
        else:
            tree.append(((lettre, elem[0]), elem[1]+nb))
    return tree[0][0]

def code(tree, dico={}, c=''):
    """Renvoi un dictionnaire {lettre : code}"""
    if isinstance(tree[0], str):
        dico[tree[0]] = c + '0'
    else:
        dico = code(tree[0], dico, c + '0')
    if isinstance(tree[1], str):
        dico[tree[1]] = c + '1'
    else:
        dico = code(tree[1], dico, c + '1')
    return dico

def huffman(text):
    """Trouve le code de Huffman pour le texte"""
    association = [(i, text.count(i)) for i in set(text)]
    association.sort(lambda x, y: cmp(x[1], y[-1]))

    tree = arbre(association)
    dico = code(tree)
    return ''.join(dico[i] for i in text)

print huffman('aaaabbc')

Une autre implémentation de Huffman en Python. Je n'utilise pas les objets, qui sont à mon sens inutiles ici.
On commence par déterminer les lettres présentes (ou tout autre symbole) et par trouver le nombre d'apparition de celles-ci avec la list comprehension. On la trie pour avoir en premier les symboles qui apparaissent les moins souvent. Dans l'exemple ça donnera [('c', 1), ('b', 2), ('a', 4)].
Ensuite, la fonction arbre renvoie l'arbre qui correspond à la liste des correspondances : elle renverra (('c', 'b'), 'a').
Ensuite on crée le code de Huffman, avec code. La fonction est récursive et analyse une par une les branches l'arbre. On utilise un dictionnaire pour stocker le code. Ça donnera {'a': '1', 'c': '00', 'b': '01'}.
Enfin, une fois qu'on a tout ça il suffit de remplacer les différents symboles par le code qui leur correspond .

SirJulio, Dark-Side> Hum. Comme l'a fait remarquer bluestorm sur irc, expliquer mon code revient à expliquer Forth. Mais bon, soit :

Forth est un langage à stack (qui utilise donc la notation rpn inversée). 4 3 + s'évaluera à 7. Forth dispose de mots pour afficher des nombres (le point, "."), des charactères (emit) ainsi que des strings (type).

Lorsque l'on définie une string, on utilise la syntaxe s" Hello World" (l'espace au début est volontaire). Cela place sur la stack un pointeur vers le début du string ainsi que la taille du string.

Forth dispose également des boucles, dont la syntaxe est la suivante :

10 0 do ... loop ( de 0 à 9, faire ... )

À l'intérieur d'une boucle, on peut accéder à l'itérateur courant grâce au mot "i". Par exemple :

10 0 do i . loop

affichera :

0 1 2 3 4 5 6 7 8 9

On définie un mot Forth avec les deux points : (grosso-modo, il s'agit d'une définition de fonction). Par exemple :

: compteur    0 do i . loop ;
10 compteur ( affiche le même résultat que plus haut )

Si l'on souhaite afficher une string (sans passer par le mot type), on peut définir :

: print-string     0 do dup i + c@ emit loop drop ;

Ou plus simplement :

: foreach         over + swap ;
: print-string    foreach do i c@ emit loop ;

(le mot c@ permet d'accéder au charactère stoqué à l'adresse mémoire)

Le reste de mon code consiste à :

• Récupérer le premier char de la string, placer 0 sur la stack
• Pour chaque char, comparer avec celui en mémoire :
  
  • s'il est équivalent, incrémenter le compteur
  • sinon, afficher le compteur, l'ancien char puis placer le nouveau char et 0 sur la stack

Bref, un message dans un forum, c'est un peu court pour expliquer Forth (même s'il s'agit d'un langage très simple). Renseignez vous sur wikipedia ou lisez ce cours .

Pmol : je pense que ta fonction de construction de l'arbre est fausse. Elle est simple, très simple, a l'air rapide, et c'est trop beau pour être vrai.

def arbre(liste):
    tree = [liste[0]]
    for lettre, nb in liste[1:]:
        elem = tree.pop()
        if nb > elem[1]:
            tree.append(((elem[0], lettre), elem[1]+nb))
        else:
            tree.append(((lettre, elem[0]), elem[1]+nb))
    return tree[0][0]

Quel est l'arbre construit pour la distribution de fréquences ((a 1) (b 1) (c 1) (d 1)) (par exemple le texte "abcd") ?

Citation : bluestorm

Pmol : je pense que ta fonction de construction de l'arbre est fausse. Elle est simple, très simple, a l'air rapide, et c'est trop beau pour être vrai.

Quel est l'arbre construit pour la distribution de fréquences ((a 1) (b 1) (c 1) (d 1)) (par exemple le texte "abcd") ?

Bluestorm, je te hais.
J'ai ('d', ('c', ('b', 'a'))). Je corrige.

Bon, vu que personne n'a encore évoqué la compression par dictionnaire, je m'y mets. Voici ce que j'ai, en Haskell :

module CompressionDico where

import Data.Map as Map

lzwLike::String->String->Map String Int->[Int]
-- Compresser une chaine vide revient a une chaine vide
lzwLike []  []      _     = []
-- Si le buffer est vide, on charge un caractere et on reprend la compression
lzwLike []  (hd:tl) dico = lzwLike [hd] tl dicco
-- Si le contenu du buffer est dans le dico, on charge 1 caractère de plus dans
-- le buffer et on continue. Sinon, on sort le code dico du début du buffer et
-- on ajoute le buffer au dico.
lzwLike mot (hd:tl) dico = 
    if findWithDefault (-1) mot dico /= (-1)
      then lzwLike (mot ++ [hd]) tl dicco 
      else dico ! (init mot) :  lzwLike [(last mot)] (hd:tl) nouvoDico
   where nouvoDico = insert mot (size dico + 1)  dico 
-- S'il ne reste plus rien après le buffer, on compresse ce dernier cara par 
-- cara. Ne devrait pas arriver, mais on sait jamais.
lzwLike mot []      dicco = 
    if findWithDefault (-1) mot dico /= (-1)
      then [dico ! mot]
      else dico ! [head mot] : lzwLike (tail mot) [] dico

La fonction lzwLike (qui est une compression dictionnaire basique qui s'inspire de l'idée générale de lzw, d'où le nom) prend en paramètre le buffer, la chaine à compresser et le dictionnaire. Vous pouvez par exemple l'appeler comme ça :

diccoDeBase = Data.Map.insert "h" 1 (Data.Map.singleton "a" 2)
chaine = lzwLike "" "hahaha" diccoDeBase

chaine vaut alors [1, 2, 3, 3]. Vous pouvez faire une fonction pour appeler lzwLike plus facilement :

compression [] _ = []
compression s d = lzwLike "" s d

Mais c'est pas franchement utile.

J'ai pas testé en profondeur, y'a donc probablement des erreurs. Mais le principal problème de ce code (comme tous mes codes Haskell) est qu'il est assez crade et probablement trop verbeux. Si vous avez mieux...

Et voici le codage de Huffman en Perl !
Il me reste à coder la fonction de décodage, mais là, j'en peux plus :x .
En bas on peut voir un exemple d'utilisation .

#!/usr/bin/perl

use strict;
use warnings;

use Data::Dumper;

# Make the tree from the input string
sub make_tree {
  my (%frq, @trees);
  $frq{$_}++ for (split //, shift);
  push @trees, { val => $_, wgt => $frq{$_} } for (keys %frq);
  while ($#trees > 0) {
    @trees = sort { $a->{wgt} <=> $b->{wgt} } @trees;
    my ($t1, $t2) = (shift @trees, shift @trees);
    push @trees, { 1 => $t1, 0 => $t2, wgt => $t1->{wgt} + $t2->{wgt} };
  }
  return $trees[0];
}

# Make the hash letter => code from the input tree
sub make_dict {
  # Auxiliary function
  sub aux {
    my ($tree, $path, $dict) = @_;
    if ($tree->{val}) {
      $dict->{ $tree->{val} } = $path;
    } else {
      aux ($tree->{$_}, ($path.$_), $dict) for ('0','1');
    }
  }

  my $dict = {};
  aux shift, '', $dict;
  return $dict;
}

# Encode the input string, returning the encoded string and the tree
sub encode {
  my ($input, $result) = (shift, '');
  my $tree = make_tree $input;
  my $dict = make_dict $tree;
  for (split //, $input) {
    $result .= $dict->{$_};
  }
  return ($result, $tree);
}

# Decode the input string with the tree, returning the decoded string
sub decode {
  my ($input, $tree) = @_;
  my ($result, $current) = ('', $tree);
  for (split //, $input) {
    $current = $current->{$_};
    if ($current->{val}) {
      $result .= $current->{val};
      $current = $tree;
    }
  }
  return $result;
}

my ($str, $tree) = encode "go go gophers";
print "$str\n", Dumper $tree;
print "\n", (decode $str, $tree), "\n";

Yop, une version de Huffman en Io.

Soyez tolérants, c'est mon premier programme de plus de 3 lignes avec ce langage... (par contre, tout conseil me ferait plaisir !)
J'ai essayé de faire vraiment l'algo naïf, avec une "vraie" structure d'arbre et tout et tout (le but était aussi de faire une sortie en langage DOT, pour la suite GraphViz qui génère automatiquement des graphes => c'est pas encore au point et j'ai pas trop le temps là, j'essaierais d'éditer un peu plus tard...).

##################################
# Naive Huffman coding in Io
# huff.io
# use with: "$>io huff.io aString"
##################################
    
# Prototype for a Huffman binary tree
Tree := Object clone do(
    weight := 0
    key := nil
    lbranch := nil
    rbranch := nil
    
    # Make Huffman encoding table
    getCode := method( path, table,
        if(self key, 
            table atPut(key, path))
        if(lbranch, lbranch getCode(path .. "0", table))
        if(rbranch, rbranch getCode(path .. "1", table))
    )
    
    # write linx
    writeLinks := method(file,
        if(lbranch, file write(if(key,key,"zorg"), " -> ",if(lbranch key, lbranch key, key .."0"),"\n")
                    lbranch writeLinks(file))
        if(rbranch, file write(if(key,key,"zorg"), " -> ",if(rbranch key, rbranch key, key .."1"),"\n")
                    rbranch writeLinks(file))
    )
    
    # graph
    writeGraph := method(file,
        file write("digraph g {\n")
        self writeLinks(file)
        file write("}\n")
    )
)

# List of trees used to build Huffman tree
treeList := List clone do(
    
    # Initialize self from a string
    init := method(str,
        struct := Map clone
        str foreach(c,
            char := c asCharacter
            if(struct hasKey(char),
                struct atPut(char, struct at(char) + 1),
                struct atPut(char, 1)))
        struct foreach(k,v,
            lTree := Tree clone
            lTree weight = v
            lTree key = k
            self append(lTree)
        )
    )
    
    # Return index of lightest tree in self
    minWeight := method(
        minw := self at(0) weight
        ind := 0
        self foreach(i, t,
            if(t weight < minw, ind = i 
                                minw = t weight)
            return ind))
            
    # Couple the 2 lightest trees in self
    # replace them in self by this new tree
    couple := method(
        t1 := self at(self minWeight)
        self removeAt(self minWeight)
        t2 := self at(self minWeight)
        self removeAt(self minWeight)
        ntree := Tree clone
        ntree weight := t1 weight + t2 weight
        ntree lbranch := t1
        ntree rbranch := t2
        self append(ntree)
    )
    
    # Return Huffman Tree
    makeHuffTree := method(
        while(self size > 1, 
            self couple)
        return self at(0))
)

# Retrieve command-line input string
string := System args at(1)
writeln("Input : ", string)

# 
treeList init(string)
huffTree := treeList makeHuffTree
table := Map clone
writeln("***getCode***")
huffTree getCode("",table)
writeln(":::Table:::")
table foreach(k,v,
    writeln(k," => ",v))
    
# GraphViz file
phil := File clone
phil open("huffgraph.dot")
huffTree writeGraph(phil)

GuilOooo> Chouette, un Haskelleux de plus et en plus j'ai des conseils à lui donner

• findWithDefault n'est pas du tout adapté en l'occurrence. Il faut lui préférer lookup et utiliser le pattern matching :
  
  

  case Map.lookup mot dico of
      Just x  -> ... -- x = dico ! mot   
      Nothing -> ... -- équivalent à false avec findWithDefault
  

  
  
• mot ++ [hd] (ainsi que init mot ou last mot) sont très coûteux en temps de calcul (puisque de complexité O(N)). La solution consiste à utiliser leurs inverses (hd:mot, tail mot et head mot) (qui sont O(1)). Cela revient à stoquer dans le dico les mots à l'envers, mais ce n'est pas gênant .
• Et pour finir, dico ne prends qu'un seul C

Sinon, bravo (j'étais entrain de regarder LZW sur Wikipedia quand tu as posté, j'ai été surpris). Je vois pas encore super bien comment le décodage fonctionne par contre (avec LZW, il n'est pas nécessaire de sauvegarder le dico -- mais avec ton algo, si ?)

J'ai l'impression qu'il n'y en a pas beaucoup qui ont fait la fonction de compression. Pourtant c'est assez compliqué aussi car le code chaque lettre n'est pas définie sur un octet mais sur n'importe quel nombre de bits (et par nécessairement des multiples de 8). Or, comme tout le fonctionnement d'un PC est basé sur les octets, c'est assez contraignant de travailler bit à bit. Par exemple une lettre pourra se trouvé à cheval sur 2 octets différents etc donc il ne suffit pas simplement de remplacé chaque lettre par sa valeur sur un octet sinon il n'y aurait presque pas de gain. Tout l'intérêt d'Huffman c'est justement qu'on peut faire rentrer sur un seul octet plus d'une lettre. On ne peut donc pas simplement concaténer chaque remplaçant du caractère, car cela limite terriblement l'efficacité du codage (je ne sais pas si je suis très clair là).


J'aimerais donc pouvoir comparer ma technique avec les votres.

Pour ceux qui ne connaissent pas le Python, voilà comment je procède :

Chaque élément de l'arbre a un attribut code qui vaut 1 ou 0 selon la branche
string contient la chaîne à compresser
Une variable temporaire newchar contient la valeur de l'octet sur lequel je travail
Newstring contient la nouvelle chaîne de caractères
rank sert à connaître la position du bit sur lequel je travail dans l'octet actuel.
Voilà l'algorithme :

- Sur toute la chaîne à coder : 
        - Récupérer l'élément correspondant dans l'arbre
        - While 1
                - Ajouter à newchar code (1 ou 0) * 2^(7-rank) #j'inverse la position dans l'octet pour faciliter la décompression
                - Augmenter rank de 1
                - Si rank ==8 #on est arrivé à la fin de l'octet
                        - remettre rank à 0
                        - ajouter le caractère équivalent à la valeur de newchar à newstring
                        - remettre newchar à 0
                - Si élément à un parent
                        - élément = parent de élément
                - sinon :
                        - break #on a finit de coder élément
- Si newchar != 0 #un caractère a été écrit mais sa taille ne vaut pas un octet donc il n'a pas été ajouté :
        - Ajouter newchar à newstring
- Retourner newstring à l'envers #la encore j'inverse la chaîne pour faciliter la décompression

La version Python est disponible dans mon précédent message.

J'attends vos critiques

Hey, c'est pas con l'output en dot %% Je vais tâcher de m'y atteler pour mon script Perl (ça va être chaud ).
D'ailleurs, voici la fonction decode (je l'ajoute aussi à mon ancien message) :

# Decode the input string with the tree, returning the decoded string
sub decode {
  my ($input, $tree) = @_;
  my ($result, $current) = ('', $tree);
  for (split //, $input) {
    $current = $current->{$_};
    if ($current->{val}) {
      $result .= $current->{val};
      $current = $tree;
    }
  }
  return $result;
}

Sobe> J'ai lu (il y a très longtemps) que c'était pas du tout OO d'utiliser les ifs. Soit, essayons...

Leaf := Object clone do(
    weight := 0
    value := nil
    init := method(w, v,
        self weight = w
        self value = v
        self
    )
    getCode := method(path, table,
        table atPut(value, path)
    )
)
Tree := Object clone do(
    weight := 0
    lbranch := nil
    rbranch := nil

    init := method(w, lbr, rbr,
        self weight = w
        self lbranch = lbr
        self rbranch = rbr
        self
    )
    getCode := method(path, table,
        lbranch getCode(path .. "0", table)
        rbranch getCode(path .. "1", table)
    )
)

Map incr := method(key, self atPut(key, self at(key) + 1))

Sequence occurences := method(
    struct := Map clone
    self foreach(c,
        char := c asCharacter
        struct atIfAbsentPut(char, 0)
        struct incr(char)
    )
    struct
)

# List of trees used to build Huffman tree
treeList := List clone do(
    fromString := method(str,
        str occurences foreach(value, weight,
            self insertBy(Leaf clone init(weight, value), "weight")
        )
    )
    
    insertBy := method(tree, key,
        bigger := self detect(t, t getSlot(key) > tree getSlot(key))
        self insertBefore(tree, bigger)
    )

    atAndRemove := method(key,
        x := self at(key)
        self removeAt(key)
        x
    )

    pop := method(self atAndRemove(0))

    couple := method(
        t1 := self pop
        t2 := self pop
        newWeight := t1 weight + t2 weight
        newTree := Tree clone init(newWeight, t1, t2)
        self insertBy(newTree, "weight")
    )
    
    makeHuffTree := method(
        while(self size > 1, 
            self couple)
        self pop
    )
)

# Retrieve command-line input string
string := System args at(1)
writeln("Input : ", string)

treeList fromString(string)
huffTree := treeList makeHuffTree
table := Map clone
writeln("***getCode***")
huffTree getCode("", table)
writeln(":::Table:::")
table foreach(k,v,
    writeln(k," => ",v)
)

(Au passage, j'ai corrigé le slot couple() -- il reste makeHuffTree() qui n'est pas très séduisant...)

Qu'en penses-tu ?

Arh arh, j'ai terminé mon générateur de graphes avec DOT . Celui-ci nécessite la bibliothèque GraphViz (bah ouais ), qu'on peut trouver sur CPAN.
Voilà le code du générateur, avec un exemple d'utilisation (la structure des arbres est la même que dans mes précédents codes) :

# Create a DOT graph from the input tree
sub tree2dot_aux {
  my ($t, $g, $cnt) = @_;
  my $count = $$cnt;
  if ($t->{val}) {
    $g->add_node($$cnt, label => "Char: '$t->{val}'\nWeigth: $t->{wgt}",
		 shape => 'box');
  } else {
    $g->add_node($$cnt, label => "Weigth: $t->{wgt}");
    for ('0', '1') {
      $$cnt++;
      $g->add_edge($count => $$cnt, label => $_);
      tree2dot_aux ($t->{$_}, $g, $cnt);
    }
  }
}

sub tree2dot {
  my ($tree) = @_;
  my $graph = GraphViz->new();
  $graph->add_node('root', shape => 'octagon', label => "root\nWeigth: $tree->{wgt}");
  my $count = 0;
  for ('0', '1') {
    $graph->add_edge ('root' => $count, label => $_);
    tree2dot_aux ($tree->{$_}, $graph, \$count);
    $count++;
  }
  return $graph;
}

Et voici l'image qu'on peut obtenir avec la phrase "go go gophers" :


BTW, personne n'a commenté mon code . Personne ne pourrait me dire ce qui va ou ne va pas ?


On peut aussi remarquer que bien que Perl ne soit pas un langage fonctionnel, la gestion des arbres n'est pas fort complexe (bien que plus difficile qu'en Haskell ou en OCaml par exemple, et (je trouve) un peu moche).