Delphi-PRAXiS - Delphi Problem mit arithmetischer Kodierung

Hallo zusammen,

ich befasse mich zur Zeit damit, verschiedene Komprimierungsarten umzusetzen. Im Moment bin ich dabei, die arithmetische Kodierung auszuprobieren. Im Prinzip läuft das auch ganz gut.

Wer nicht weiß, was ich meine:

http://www-mm.informatik.uni-mannhei...a/Schmid_2002/

Bei diesem Verfahren muß der rechner sehr genau rechnen (viele Nachkommastellen).
Mein Problem ist aber, das der Rechner zu ungenau ist, dauernd treten Rundungsfehler auf. Die fangen schon an, wenn ich die anzahl von Zeichen pro Intervall (bzw. pro extended-Zahl) auf 5 stelle. Bei einer Anzahl von 5, komrimiert die Procedure jedoch noch nicht richtig (die Zieldatei ist größer als die Ausgangsdatei) Eine Komprimierung stellt sich erst bei 9-10 ein.

Kann mir jmd. helfen mein Rundungsproblem zu beheben?

Mein Code (Achtung nicht wirklich kommentiert):

Es verden noch zwei globale variablen benötigt:

dateigr:longint;
dateiarray:array of byte;

Delphi-Quellcode:

			
procedure tform1.arith(dat:string);

var winproz:array[0..255] of extended;  //Hier weden die Prozentanteile der einelnen Bytes gespeichert

    gepackt:extended;                   //Hilfsvariable

    komp:array of extended;             //stream, in der die gepackten Daten abgelegt werden

    max:integer;                        //länge von komp

const faktor = 6;   //Anzahl an Zeichen pro intervall - je größer, desto kleiner die Datei und desto ungenauer

      gr = 1;       //grundintervall, rechter Rand

      kl = 0;       //Gundintervall linker Rand

procedure wahrscheinlichkeiten;       //winproz wird mit den prozentanteilen gefüllt.

var temp:array[0..255] of integer;

    i:integer;

begin

  for i := 0 to 255 do

    temp[i] := 0;

  for i := 0 to dateigr-1 do

  begin

    inc(temp[ord(dateiarray[i])]);

  end;

  for i := 0 to 255 do

  begin

    winproz[i] := 100 / dateigr * temp[i];

  end;

end;

procedure entpacken;

var intervall:array[0..1] of extended;

    i:integer;

    s:string;

    b:byte;

function getbyte(var links,rechts:extended):byte;        //ähnlich procedure getintervall

var i:integer;

    pos,bereich:extended;

    temp,prozbyte,prozadd:extended;

begin

  bereich := rechts - links;

  pos := 0;

  i := 0;

  repeat

    pos := (pos +  winproz[i]);

    inc(i);

  until ((bereich / 100 *pos) +links) > gepackt;

  rechts := links + (bereich / 100 *pos);

  links := links + (bereich / 100 *pos)- (bereich / 100 * winproz[i-1]);

  getbyte := i-1;

end;

var s1,s2:string;

    z:integer;

    stueck:integer;

    datei:file;

    fehler:integer;

begin

  assignfile(datei,'Arithmetisch-entpackt-'+dateiname);

  rewrite(datei,1);

  s := '';

  z := 0;

  stueck := 1;

  for i := 0 to max-1 do

  begin

    intervall[0] := kl;

    intervall[1] := gr;

    stueck := 0;

    gepackt := komp[i];

    repeat

      inc(stueck);

      b := getbyte(intervall[0],intervall[1]);

      if b <> dateiarray[z] then

        inc(fehler);

        blockwrite(datei,b,sizeof(b));

        inc(z);

    until stueck > faktor;

    analysebar.Position := round(1000 / max * i);

  end;

  closefile(datei);

  edit1.text := inttostr(fehler)+' fehler';

end;

procedure speichern;                      //Speichert die komprimierte Datei

var datei:file;

    i:integer;

begin

  assignfile(datei,dateiname+'.ari');

  rewrite(datei,1);

  for i := 0 to max-1 do

  begin

    blockwrite(datei,komp[i],sizeof(komp[i]));

    analysebar.Position := round(1000 / max * i);

  end;

  closefile(datei);

end;

procedure packen;

var intervall:array[0..1] of extended;

    i:integer;

    stueck:byte;

procedure getintervall(var links,rechts:extended;b:byte);   //bei Eingabe des z kodierenden Bytes b werden die

var i:integer;                                              //neuen Intervallgrenzen zurrückgegeben.

    bereich:extended;

    proz:extended;

begin

  bereich := rechts - links;  //aktueller Intervallbereich /rechte grenze - linke grenze

  proz := 0;

  for i := 0 to b-1 do     //bis zum betreffenden Byte werden die Prozentanteile addiert.

  begin

    proz := proz + winproz[i];

  end;

  links := links + bereich / 100 * proz;      //umrechnung des herausgefundenen Prozentanteils auf betrag

  rechts := links + (bereich / 100 * winproz[b]);

end;

var s,s2:string;

begin

  intervall[0] := kl;

  intervall[1] := gr;

  max := 0;

  stueck := 0;

  for i :=0 to dateigr-1 do

  begin

    inc(stueck);

    getintervall(intervall[0],intervall[1],dateiarray[i]);

    if (stueck > faktor) or (i = (dateigr-1)) then    //stückelung in die in faktor angegebenen Zeichen

    begin

     inc(max);

     setlength(komp,max);

     komp[max-1] :=  intervall[0]  + ((intervall[1]-intervall[0]) / 2 ) ; //mittelpunkt des intervalles wird gespeichert

     intervall[0] := kl;                                                  //neues Ausgangsintervall.

     intervall[1] := gr;

     stueck := 0;

    end;

    analysebar.Position := round(1000 / dateigr * i);

  end;

end;

begin

  dateiname := dat;

  dateieinladen;

  wahrscheinlichkeiten;

  packen;

  speichern;

  entpacken;

end;

procedure tform1.dateieinladen;  //einladen einer beliebigen Datei in das array "dateiarray"

var quelldatei:file;

    Buf: byte;

    menge:longint;

    numread:integer;

    i:integer;

begin

  AssignFile(quelldatei, dateiname);

  Reset(quelldatei, 1);

  analysebar.Max := 1000;

  menge := 0;

  quellgr.Text := inttostr(FileSize(quelldatei))+' byte';

  quellgr.Refresh;

  dateigr := FileSize(quelldatei);

  repeat

    BlockRead(quelldatei, Buf, SizeOf(Buf),numread);

    inc(menge);

    setlength(dateiarray,menge);

    dateiarray[menge-1] := buf;

    analysebar.Position := round(1000 / FileSize(quelldatei) * menge);

  until (NumRead = 0);

  closeFile(quelldatei);

end;

Am ende wir die Entpackte Datei wieder mit den originaldaten verklichen und die Anzahl an Fehlern ausgegeben. Je kleiner Faktor ist, desto weniger Fehler.

Danke für Eure Mühen