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