AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Problem mit arithmetischer Kodierung

Offene Frage von "bekrause"
Ein Thema von bekrause · begonnen am 14. Jul 2004 · letzter Beitrag vom 14. Jul 2004
Antwort Antwort
bekrause

Registriert seit: 31. Mär 2003
Ort: Essen
24 Beiträge
 
Delphi XE Professional
 
#1

Problem mit arithmetischer Kodierung

  Alt 14. Jul 2004, 16:33
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
Lernen, ohne zu denken, ist eitel; denken, ohne zu lernen, ist gefährlich. Konfuzius
  Mit Zitat antworten Zitat
rantanplan99
(Gast)

n/a Beiträge
 
#2

Re: Problem mit arithmetischer Kodierung

  Alt 14. Jul 2004, 18:02
Hi,

also da sind ein paar Sachen die ich zu deinem Sourcecode anmerken möchte:

1) 'faktor' und das speichern der komprimieren daten in extended variablen. Wenn du den Faktor = 6 setzt, heisst dass das du 6 Bytes mit einen Extended-Wert ablegst. Das widerspricht dem Ansatz das du komprimieren willst, da ein Extended-Wert 10 Bytes gross ist.

2) Du vergisst das Wahrscheinlichkeits-Array abzuspeichern welches du für das Dekomprimieren benötigst.

3) Ansonsten sieht es so aus als ob du so komprieren würdest wie es in der Theorie des Algorithmus beschrieben ist. Impelentieren tut man den Arithmetischen Algorithmus anders: meist mit Integer-Werten, und nicht mit Gleitkommazahlen. Zum anderen verwendet man auch nicht mehrere Intervalle/werte, sondern ein Intervall und fertig. Bei deinem Ansatz werden ja immer nur 6 Bytes komprimiert und dann wieder neu aufgesetzt.

Schau dir doch mal verfügbare Pascal Programme für die Arithmetische Kodierung an.
  Mit Zitat antworten Zitat
shmia

Registriert seit: 2. Mär 2004
5.508 Beiträge
 
Delphi 5 Professional
 
#3

Re: Problem mit arithmetischer Kodierung

  Alt 14. Jul 2004, 18:05
Dein angegebener Link liefert keine Info innerhalb zumutbarer Zeit
Du rechnest die ganze Zeit in Prozent; das ist nicht nötig.
Du kannst auch direkt in Wahrscheinlichkeiten 0..1 rechnen.
Noch besser ist es, den Datentyp Extended ganz zu vermeiden. Stattdessen arbeitest du
mit rationalen Zahlen (=Brüche).
Überall wo winproz{i} benützt wird, wird stattdessen temp{i} / dateigr benützt.
Entweder kannst du bei den Berechnungen den Nenner dateigr kürzen oder du erweiterst auf beiden Seiten
mit dem Nenner dateigr.

PS: ich habe den Pascal-üblichen Arrayoperator eckige Klammer ober durch geschweifte Klammer ersetzt, da sonst die Formatierung flöten geht.
Andreas
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 00:18 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