Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Huffman Codierung (Text) (https://www.delphipraxis.net/198907-huffman-codierung-text.html)

Clashhelfer 9. Dez 2018 17:05

Delphi-Version: 5

Huffman Codierung (Text)
 
Hey,
ich muss ein Programm schreiben, dass Dateien komprimieren kann und diese auch wieder ausgibt, speichert und andersherum.

Ich bin soweit, dass ich einen geschriebenen Text und eine Text Datei öffnen und komprimieren kann. Wie ich den Binärcode wieder in einen Text kriege, habe ich grob verstanden, kann es aber nicht umsetzen.
Das Ganze funktioniert ja über den Huffman Algorithmus, bei dem aus einer Liste ein Baum aufgebaut, danach der Baum abgelaufen wird, um damit den Binärcode zu erzeugen. Beim Dekomprimieren müsste man also den Baum wieder aufbauen und dann den Baum wieder ablaufen?

Ich lade das Ganze Projekt samt Anforderungen mal hoch und hoffe, dass mir jemand helfen kann. Es hapert vor allem bei dem öffnen und speichern der komprimierten Variante.

https://drive.google.com/open?id=15B...4ElBkdSLibfUbC

Danke im Voraus, ich bin echt planlos gerade!

gammatester 9. Dez 2018 18:17

AW: Huffman Codierung (Text)
 
Zitat:

Zitat von Clashhelfer (Beitrag 1420412)
Ich lade das Ganze Projekt samt Anforderungen mal hoch und hoffe, dass mir jemand helfen kann. Es hapert vor allem bei dem öffnen und speichern der komprimierten Variante.

Es ist sinnvoller, wenn Du das in ein Zip packst und hier anhängst. Nicht jeder will Google benutzen, und es ist dann auch sicher, daß es immer mit dem Beitrag verfügbar ist.

DieDolly 9. Dez 2018 18:19

AW: Huffman Codierung (Text)
 
Und statt das ganze Projekt hochzuladen, füge doch bitte nur die problematischen Passagen in Delphi-Tags hier ein. Nicht jeder will dein ganzes Projekt runterladen, öffnen und durchgehen.

Clashhelfer 9. Dez 2018 18:26

AW: Huffman Codierung (Text)
 
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

DieDolly 9. Dez 2018 18:29

AW: Huffman Codierung (Text)
 
Davon abgesehen, dass das keine Delphi-Tags sind (der gelbe Helm mit roten Haaren) und du einfach alles reinschreibst statt die Problemzonen, bin ich mir nicht sicher, ob ich nicht hier schon einen Fehler sehe?
Delphi-Quellcode:
Huffmanliste:= // BAUM LÖSCHEN;
Nutz mal STRG+D. Das bewirkt Wunder. Aber keine Ahnung, ob es das in Delphi 5 schon gibt (das benutzt ihr ja scheinbar).

Clashhelfer 9. Dez 2018 18:34

AW: Huffman Codierung (Text)
 
Ich weiß eben nicht wie ich das umsetzen soll, daher habe ich alles gepostet. Wir sollen die Datei komprimiert öffnen und schließen können (????). Außerdem soll noch dekodiert werden können,
also den Binärcode zurück in Textformat. Bisher kann das Programm nur kodieren, Txt Dateien öffnen und speichern.

Clashhelfer 9. Dez 2018 18:35

AW: Huffman Codierung (Text)
 
Zitat:

Zitat von DieDolly (Beitrag 1420421)
Davon abgesehen, dass das keine Delphi-Tags sind (der gelbe Helm mit roten Haaren) und du einfach alles reinschreibst statt die Problemzonen, bin ich mir nicht sicher, ob ich nicht hier schon einen Fehler sehe?
Delphi-Quellcode:
Huffmanliste:= // BAUM LÖSCHEN;
Nutz mal STRG+D. Das bewirkt Wunder. Aber keine Ahnung, ob es das in Delphi 5 schon gibt (das benutzt ihr ja scheinbar).

"//Baum löschen" war ein Hinweis für mich, dass ich dort den Baum noch löschen muss. Da weiß ich allerdings auch nicht wie.

Sherlock 10. Dez 2018 11:19

AW: Huffman Codierung (Text)
 
Weißt Du denn zumindest theoretisch, worum es geht? Falls die Unterrichtsstunde oder die Vorlesung verpasst wurde:
https://de.wikipedia.org/wiki/Huffman-Kodierung

Sherlock

Sherlock 14. Dez 2018 07:30

AW: Huffman Codierung (Text)
 
Schade, daß das (wie die meisten Hausaufgaben-Threads) schon tot ist. Hätte ein schönes Projekt werden können. Mal was zum Lernen aus den Anfängen der modernen Informationstheorie.

Sherlock

DieDolly 14. Dez 2018 08:58

AW: Huffman Codierung (Text)
 
Das ist glaube ich weil die Schüler alles an den Kopf geworfen bekommen und viel zu wenig Zeit dafür haben.

Luckie 14. Dez 2018 09:23

AW: Huffman Codierung (Text)
 
Abgabetermin war wohl am 10. Also nicht mehr relevant. :roll:

DieDolly 14. Dez 2018 09:27

AW: Huffman Codierung (Text)
 
Zitat:

ich muss ein Programm schreiben
Bei den Schülern fängt es schon mit dem Wort muss an.
Lehrer vermitteln meiner Meinung nach die Aufgabenstellung psychologisch inkorrekt.
Das kann indirekt und unterbewusst viel im Kopf anrichten wenn man von müssen spricht und nicht mehr über eine Aufgabe die bitte erledigt werden soll.

Hier liegt vielleicht der Hund begraben. Zusätzlich kommt noch dazu, dass das Delphigrundwissen an Schulen meist von alten Hasen vermittelt wird die keine Ahnung [mehr] haben [dazu gehöre ich auch aber ich behalte mein Unwissen bewusst für mich und unterrichte nicht :thumb:]. Ach ja und dann noch der Zeitmangel.

Sherlock 14. Dez 2018 09:47

AW: Huffman Codierung (Text)
 
Ich war auch mal Schüler, wenn die Eltern einen nicht mit extrakurrikulären Aktivitäten zumüllen ist alles machbar. Vor allem, wenn man nicht die Sachen auf den letzten Drücker macht. Ich werde weiterhin Hausaufgabenthreads lesen, aber Hilfestellungen in Form von Quellcode gibt es erst nach erkennbarem Interesse.

Sherlock

Neutral General 14. Dez 2018 10:57

AW: Huffman Codierung (Text)
 
Ich bezweifle dass "muss" und "bitte erledigen" einen Unterschied macht. Unterm Strich MUSS man die Aufgabe erledigen, ansonsten gibt es Ärger in irgendeiner Form. Und das ist den Leuten bewusst. Egal wie nett der Aufgabensteller das Ganze ausdrückt.

Das Problem bei Hausaufgaben Threads ohne Eigeninitiative ist entweder, dass es Schüler sind die grundlegend kein Interesse an dem Fach haben (was ja grundlegend in Ordnung ist) und dementsprechend die Motivation zu lernen oder Aufgaben zu erledigen sehr gering ist oder es sind Studenten die nur eine Vorlesung Informatik/Programmieren haben und sich nicht für den IT-Teil ihres Studiums interessieren. ODER es sind tatsächlich Informatikstudenten die sich einfach nur irgendwie durchmogeln wollen.

DieDolly 14. Dez 2018 11:08

AW: Huffman Codierung (Text)
 
Zitat:

Ich bezweifle dass "muss" und "bitte erledigen" einen Unterschied macht. Unterm Strich MUSS man die Aufgabe erledigen, ansonsten gibt es Ärger in irgendeiner Form
Es ist psychologisch bewiesen, dass es besonders auf die Art und Weise ankommt wie man einem sowas vermittelt. Kommt man direkt mit Müssen und Nur eine Woche um die Ecke, ist das psychologisch gesehen so ziemlich die schlechteste Herangehensweise die es gibt.

Eine Ausbildung muss nicht schön sein das ist mir klar. Aber Lehrer sind meist doch auch Pädagogen irgendwo. Und da darf man doch auch erwarten, dass die ihr pädagogisches Wissen auch korrekt nutzen statt stumpft irgendeinem Lehrplan zu folgen. Ein paar nette und gut gewählte Worte jeden Tag können das Hirn ganz schön positiv umdrehen.

Medium 17. Dez 2018 08:10

AW: Huffman Codierung (Text)
 
Zitat:

Zitat von DieDolly (Beitrag 1420858)
Aber Lehrer sind meist doch auch Pädagogen irgendwo. Und da darf man doch auch erwarten, dass die ihr pädagogisches Wissen auch korrekt nutzen statt stumpft irgendeinem Lehrplan zu folgen. Ein paar nette und gut gewählte Worte jeden Tag können das Hirn ganz schön positiv umdrehen.

Das ist (leider) nicht wirklich der Fall. Man nennt sie zwar so, aber der pädagogische Anteil im Studium ist (oder zumindest war bis vor kurzem, evtl. hat sich ja was getan) lächerlich. Ich habe 4 Lehrer in meinem Freundeskreis, die alle vor so ca. 8 Jahren mit dem Studium fertig waren, und die Info die ich von diesen bekam war, dass man freiwillig ein paar Kurse belegen konnte und so die allernötigsten Grundlagen leidlich abgedudelt wurden, aber ob man nachher wirklich als reiner Wissensvermittler oder doch als pädagogischer "Lebenshelfer" agiert (bzw. agieren KANN) obliegt weitestgehend den individuellen Selbstansprüchen, eigenem Engagement und ein Stück weit der Persönlichkeit.

Nicht umsonst gibt es mitunter sogar noch mindestens zwei verschiedene Studiengänge, die das Wort "Pädagogik" direkt im namen tragen. Die sind es dann aber auch wirklich. Lehrer werden - warum auch immer - nur im Volksmund so betitelt.

Luckie 17. Dez 2018 12:21

AW: Huffman Codierung (Text)
 
Bitte kommt zurück zum Thema.


Alle Zeitangaben in WEZ +1. Es ist jetzt 05:48 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz