Huffman Codierung (Text)

[Clashhelfer]

Code:

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.

Formular:

Code:

unit GUI;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  uTHuffman, StdCtrls, Menus;

type
  TForm1 = class(TForm)
    MEingabe: TMemo;
    Button1: TButton;
    Label1: TLabel;
    Button2: TButton;
    Datei1: TMenuItem;
    Beenden1: TMenuItem;
    N1: TMenuItem;
    Druckereinrichtung1: TMenuItem;
    Drucken1: TMenuItem;
    N2: TMenuItem;
    Speichernunter1: TMenuItem;
    Speichern1: TMenuItem;
    N3: TMenuItem;
    Schlieen1: TMenuItem;
    ffnen1: TMenuItem;
    Neu1: TMenuItem;
    N4: TMenuItem;
    Komprimiertspeichern1: TMenuItem;
    N5: TMenuItem;
    Komprimiertffnen1: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Label3: TLabel;
    MAusgabe: TMemo;
    Ausgabe: TLabel;
    Button3: TButton;
    m: TMainMenu;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Neu1Click(Sender: TObject);
    procedure ffnen1Click(Sender: TObject);
    procedure Schlieen1Click(Sender: TObject);
    procedure Beenden1Click(Sender: TObject);
    procedure Speichern1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private-Deklarationen }
    Huffman: THuffman;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ffnen1Click(Sender: TObject);
 {procedure LoadFromFile(const FileName: string);
  begin
  // ShellExecute(Application.Handle, 'open', PChar('C:\x.doc'), nil, nil, SW_NORMAL);
  end;
  begin
  end;}
  begin
  OpenDialog1.Filter:='Textdateien (*.txt) |*.TXT|alle Dateien (*.*) |*.*';     //Aus Delphi Hilfe entnommen
  OpenDialog1.Title:= 'Öffnen';
  if OpenDialog1.Execute then MEingabe.Lines.LoadfromFile(Opendialog.FileName);

  end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   Huffman:=THuffman.Create; //Klassenbezeichner erstellen (Objekt)
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    Huffman.free;  //Ebenfalls mit Klassenbezeichner machen, wenn erstellt
end;

procedure TForm1.Neu1Click(Sender: TObject);
begin
MEingabe.text:='';
MAusgabe.text:='';
end;

procedure TForm1.Schlieen1Click(Sender: TObject);
begin
close;
end;

procedure TForm1.Beenden1Click(Sender: TObject);
begin
close;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   Huffman.zaehlen(MEingabe.lines.text);
   Huffman.HuffmanlisteErzeugen;
end;

procedure TForm1.Speichern1Click(Sender: TObject);
 procedure SaveToFile(const FileName: string); //virtual;
  begin
  Savedialog1.defaultext:='txt';
  SaveDialog1.Filter:='Textdateien (*.txt) | *.TXT|alle dateien (*.*) | *.*';
  SaveDialog1.Title:='Baum in eine Textdatei exportieren';
  if SaveDialog1.Execute then MEingabe.Lines.SaveToFile(SaveDialog1.FileName);

  end;
begin
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  
//MAusgabe.lines.text:= THuffman.HuffmanlisteAnzeigen;
//MAusgabe.lines.text:='';

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 Huffman.Durchlauf;
 Showmessage(Huffman.getcodestring);
end;

end.

Zugehörige Aufgabe:
Die fehlenden Funktionalitäten zum Schreiben, Lesen der Binärdateien und die Dekompression sind in der Klasse „THuffman“ zu ergänzen (Dazu gibt es im Folgenden einige Hinweise…). (Braucht ihr die)

Danke im Voraus