unit uTHuffman;
interface
type
TZeichenfeld = array[char] of cardinal;
TCodes = array[char] of string;
THuffmanknoten = class
Zeichen: char;
Gewicht: cardinal; //Häufigkeit
next: THuffmanknoten;
L,R: THuffmanknoten;
end;
THuffman = class
private
Haeufigkeiten: TZeichenfeld;
Text: string;
Codes: TCodes;
Codestring: string;
Huffmanliste: THuffmanknoten; //Anfang der Liste(Wurzel)
public
//procedure WriteKnoten(Knoten: Thuffmanknoten);
// ------------------
procedure Durchlauf;
//durchläuft den Baum und guckt, wo sich "Nil" befindet, um Baum aufzubauen
procedure zaehlen(T: string);
//T ist der zu komprimierende Text.
//Bestimmt die Zeichenhäufigkeit und speichert diese im Attribut
//"Häufigkeiten".
procedure HuffmanlisteErzeugen;
//Erstellt den Codebaum(Liste).
//function HuffmanlisteAnzeigen
function getcodestring: string;
procedure speichern(Dateiname:string);
procedure laden(Dateiname: string);
private
procedure KnotenEinsortieren(k: THuffmanknoten);
//"K" existiert und wird in die Liste nach Gewicht(Sortierung)eingefügt.
//"Leicht" nach ganz vorne.
end;
implementation
procedure THuffman.Durchlauf;
procedure charcode(N: THuffmanknoten; code: string);
begin
if (N <> nil) then
if (N.L = nil) and (N.R = nil) then
Codes[N.Zeichen]:= code
else begin
charcode(N.L, Code + '0');
charcode(N.R, Code + '1');
end;
end;
begin
charcode(Huffmanliste,'');
end;
procedure THuffman.zaehlen(T:string);
//T ist der zu komprimierende Text.
//Bestimmt die Zeichenhäufigkeit und speichert diese im Attribut
//"Häufigkeiten".
var
z: char;
i: cardinal;
begin
//Häufigkeiten löschen
for z:=#0 to #255 do Haeufigkeiten[z]:=0;
//Text durchlaufen und Häufigkeiten addieren ...
for i:=1 to length(T) do inc(Haeufigkeiten[T[i]]);
//wenn man auf einen Buchstaben trifft, erhöhe Häufigkeit(Index) aus dem Text um 1
Text:=T;
end;
procedure THuffman.HuffmanlisteErzeugen; //Feld auslesen falls Wert größer als 1 = einsortieren
//Erstellt den Codebaum(Liste).
//wir durchlaufen das Feld und erstellen für jedes Zeichen
//mit einer Häufigkeit +1 einen Knoten
var
x: THuffmanknoten;
c: char;
begin
for c:=#0 to #255 do begin
if Haeufigkeiten[c] > 0 then begin
x:=Thuffmanknoten.create;
x.Zeichen:=c;
x.Gewicht:=Haeufigkeiten[c];
KnotenEinsortieren(x);
end;
end;
while (Huffmanliste <> nil) and (Huffmanliste.next <> nil) do begin
x:=THuffmanknoten.create;
x.Gewicht:= Huffmanliste.Gewicht + Huffmanliste.next.Gewicht;
x.L:=Huffmanliste;
x.R:=Huffmanliste.next;
Huffmanliste:= Huffmanliste.next.next;
KnotenEinsortieren(x);
X.L.next:=nil;
X.R.next:=nil;
end;
end;
procedure THuffman.KnotenEinsortieren(k: THuffmanknoten);
//"K" existiert und wird in die Liste nach Gewicht(Sortierung)eingefügt.
//"Leicht" nach ganz vorne.
procedure einsortieren(var Knoten: THuffmanknoten);
begin
if Knoten= nil then Knoten:= k
else
if Knoten.Gewicht < k.Gewicht then einsortieren(Knoten.next)
else begin
k.next:= Knoten;
Knoten:=k;
end;
end;
begin
einsortieren(Huffmanliste)
end;
{function Huffmanlisteanzeigen;
begin
Codetabelle;
... :='';
for i:= 1 to length(Huffmanliste) Codes[...]
end;}
function THuffman.getcodestring: string;
var
i: integer;
begin
codestring:= '';
for i:= 1 to length(text) do
codestring:= Codestring + Codes[Text[i]];
result:= Codestring;
end;
procedure THuffman.speichern(Dateiname:string);
var
Datei: file of byte;
B: byte;
procedure WriteKnoten(Knoten: THUffmanknoten);
var
b:byte
begin
b:=ord(Knoten.Zeichen);
Write(Datei, b);
if (Knoten.L <> nil) then WriteKnoten(Knoten.L);
if (Knoten.R <> nil) then WriteKnoten(Knoten.R);
end;
begin
assignfile(Datei, Dateiname);
rewrite(datei);
B:=length(Codestring) mod 8;
Write (Datei, B);
writeKnoten(Huffmanliste);
//hier fehlt was
end;
procedure THuffman.laden(Dateiname: string);
var
Datei: file of byte;
b: byte;
i: integer;
begin
assignfile(Datei, Dateiname);
reset(datei);
codestring:='';
Huffmanliste:= // BAUM LÖSCHEN;
CreateKnoten(Huffmanliste);
read(Datei, b, 1);
for i:=0 to 7 do begin //Bits nach links rausschieben und Bit 7 prüfen:
if (b and 128 = 0) then Codestring:=Codestring + '0'
else Codestring:=Codestring + '1';
b:=b shl 1;
end;
end;
end.