Huffman-Codierung mit Perl 6

Im SVN-Repository von pugs gibt es viele Testcases, unter anderem ein Verzeichnis mit “99 Problems”.

Diese Probleme beziehen sich auf eine Liste von Programmieraufgaben, ursprünglich für die Programmiersprache Logo vorgesehen.

Etwa zwei Drittel dieser Probleme sind schon in Perl 6 gelöst, ein paar interessante sind noch übrig.

Gestern habe ich mich an den Huffman-Code (Problem 50) gemacht.

Das Problem

Der Huffman-Code dient der Komprimierung, und zwar hat man einige Zeichen und ihre Häufigkeiten in einem Text gegeben, und soll anhand dessen für jeden Buchstaben eine Bitsequenz erstellen, sodass die Länge des ganzen Textes minimiert wird.

Tendenziell gilt also, dass häufigere Zeichen eine kürzere Sequenz bekommen. Das führt zu einem Problem: die Sequenzen müssen “präfixfrei” sein, d.h. keine Sequenz darf eine andere als ihern Anfang enthalten.

Wenn ‘a’ also z.B. als ‘10′ kodiert wird, darf kein anderes Zeichen mit ‘10′ anfangen – sonst wüsste man beim lesen der kodierten Daten nicht, ob das ein ‘a’ ist oder eines der Zeichen, die mit ‘10′ anfangen.

Wie geht man also vor?

Der Algorithmus

Der Algorithmus ist erstaunlich einfach. Wenn man ihn mit Stift und Papier nachvollzieht, malt man einfach für jeden Buchstaben eine Box um den Buchstaben, und schreibt die Häufigkeit des Buchstabens hinein:

Dann schreibt man über die beiden Buchstaben mit den niedrigsten Werten für die Häufigkeiten die Summe der Häufigkeiten, und verbindet die Summe und die beiden Werte mit Geraden:

Der Übersichtlichkeit wegen wurden die beiden Buchstaben nach unten verschoben.

Das ganze wiederholt man, wobei man ab dem zweiten Schritt die beiden ersetzten Buchstaben nicht mehr betrachtet, sondern nur noch ihre Summe:

Damit fährt man fort, bis alle Buchstaben verbunden sind:

Und am Ende:

Jetzt fehlt nur noch ein Schritt: an jede Verbindungslinie eine 0 oder eine 1 einzeichnen, und zwar immer zu dem niedrigeren Wert eine 0 und zum höheren eine 1. Umgekehrt ginge es genau so, man muss sich nur auf eine Art festlegen.

Wenn man jetzt die Kodierung eines Buchstaben wissen will, folgt man dem Baum von der Wurzel (oben) bis zu dem Buchstaben, und notiert sich die an den Verbindungen stehenden Nullen und Einser. Ein ‘a’ wird in diesem Beispiel also als ‘0′ kodiert, ein ‘e’ als ‘1101′.

Mit den verwendeten Häufigkeiten kommt man in Summe auf 100 Zeichen. Wenn man diese “ganz normal” mit einer festen Anzahl an Bits pro Zeichen kodiert, benötigt man 4 Bit pro Zeichen, und damit 300 Bit. Mit dieser Huffmankodierung benötigt man nur 224 Zeichen, man hat also etwa ein Viertel der Datenmenge eingespart.

Perl6-Implementierung

Und hier kommt die Implementierung in Perl 6:

use v6-alpha;
use Test;
plan 1;

# die Häufigkeiten
my @fr = (
        ['a', 45],
        ['b', 13],
        ['c', 12],
        ['d', 16],
        ['e', 9 ],
        ['f', 5 ],
         );

# Das erwarten wir, wird später zum Testen verwendet
my %expected = (
        'a' => '0',
        'b' => '101',
        'c' => '100',
        'd' => '111',
        'e' => '1101',
        'f' => '1100'
        );

my @c = @fr;

# hier wird der Baum aufgebaut
while @c.elems > 1 {
    # nach dem zweiten Element der Arrays sortieren:
    @c = sort { $^a[1] < => $^b[1] }, @c;
    my $a = shift @c;
    my $b = shift @c;
    unshift @c, [[$a[0], $b[0]], $a[1] + $b[1]];
}

my %res;

# diese Funktion durchläuft rekursiv den Baum und speichert die
# Ergebnisse im Hash %res ab
sub traverse ($a, Str $code = ""){
    if $a.WHAT eq "Str" {
        %res{$a} = $code;
    } else {
        traverse($a[0], $code ~ '0');
        traverse($a[1], $code ~ '1');
    }
}

traverse(@c[0][0]);

# und jetzt der Vergleich mit dem erwarteten:

is(%res, %expected, "Huffman tree builds correctly");

Der schwierigste Teil ist erledigt: Der Baum ist gebaut, und aus dem Baum wurde die Kodierung extrahiert. Wenn man jetzt tatsächlich Text kodieren will, muss man ihn Zeichen für Zeichen durchlaufen, und jedes Zeichen $c durch %res{$c} ersetzen. Um es binär darzustellen, müsste man das Ergebnis noch durch die Funktion pack jagen.

Leave a Comment