Problem mit arithmetischer Kodierung

[bekrause]

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