Komprimierung : Wie geht das?

[NickelM]

Hallo ihr,

Ich arbeite in meinem Programm mit fertigen Komprimierungen.

Das ist alles schön und gut und funkt.

Nur ich frag mich solangsam, wie man sowas macht. Nur vom Aufbau her.
Wie macht man aus einer 5 MB großen datei eine 1 MB und wie kann man das dan wieder zurück machen?
Ich hab schon gegoogelt und finde irgendwie net das was ich suche.

Ich kann mich nicht vorstellen, wie man aus 1 MB datei wieder die ursprünglichen 5 MB machen kann?
Wie kann man den aus weniger mehr machen? bzw. wie weis man wo man was wieder dranhängen muss?

Ich weis ja schon wie ich Bytes schreiben kann und lesen kann, deshalb frag ich mich, wie man Bytes wegnehmen kann und wie man deise wegnenohmen Bytes wieder herstellen kann.

Hoffe jemand weis eine gute Seite (am besten deutsch kann auch englisch sein), wie man den Aufbau einer Komprimierung erklärt bekommt.
Vllt kanns mir auch jemand erklären.

[ATSV]

Hast du schonmal ins Wiki geschaut?

[-Phantom-]

Willst du wissen wie man es genau macht? Oder willst du es einfach nur machen? Es gibt dafür ein paar Komponenten wie abbrevia

[Daniel]

Moin,

da gibt es natürlich beliebig raffinierte (und dann meist auch komplizierte) Algorithmen, für den Einsteig und um sich das Prinzip klar zu machen, könnte die Lauflängen-Kodierung hilfreich sein:
http://de.wikipedia.org/wiki/Laufl%C3%A4ngenkodierung

Im Prinzip geht es darum, wiederkehrende Zeichenfolgen zusammen zu fassen:

Wenn Du AAAAACBBBBBB als Zeichenfolge hast, könntest Du auch {5A}C{6B} schreiben und müsstest Dir mit Steuerzeichen - hier die geschweiften Klammern - nur merken, was wohin gehört. (Das ist jetzt natürlich stark vereinfacht)

[NickelM]

Danke an allen.

Also ich glaube vom Prinzip her wie z.b. diese Zeichenketten vereinfachen hab ich jetzt kapiert.
Nur weis ich von dem TBytes Array schreiben wie ein Record z.b. ein Bytes aussieht.
Wenn ich mir das so anguge, frag ich mich wie man sowas z.b. Komprimeiren könnte.

Also die vorgehensweise, wie Bytes zupacken sozusagen.

@-Phantom- : Es geht mir um die vorgehensweise.

[Daniel]

Ist identisch.
Die o.g. Buchstaben sind auch "nur" Bytes. Das 'A' hat den numerischen Wert von 65. Im Speicher steht da auch nur der Zahlenwert, den wir mit an passender Stelle als den Buchstaben 'A' interpretieren. Dem Algorithmus ist das aber egal. Der sieht nur eine Folge von Bytes. Das (vereinfachte) Prinzip lautet "Suche Folgen von gleichen Werten und ersetze diese durch was Kürzeres".
Kritisch wird es, wenn in Deinem Array NUR unterschiedliche Zahlen vorkommen, dann wirst Du mit dem o.g. Verfahren keinen Blumentopf gewinnen können. Dann könnte man jedoch andere Verfahren starten, wie sie z.B. bei MP3 oder JPG zum Einsatz kommen: Verlustbehaftete Kompression. Das heisst, dass die Daten (leicht) verändert werden, um bessere Kompressionsraten erzielen zu können. So könnte man z.B. die Werte eines Arrays runden, um wieder Bereiche von identischen Werten zu haben. Sehr plastisch siehst Du das, wenn Du in einem Grafikprogramm die Kompressionsrate beim JPG-Export sehr hoch und die Glättung sehr niedrig stellst. Dann bilden sich Klötzchen, die sich aber wunderbar komprimieren lassen. (Auch wieder arg vereinfacht dargestellt.)

[himitsu]

Man könnte auch mal in der DP, Google oder bei Wiki nach Huffman, bzw, Entropiekodierung schauen.

Hierbei wird erstmal die Häufigkeit der vorkommenden Bytes gezählt und dann werden die vorhandenen Bytes mit einer dynamischen Anzahl an Bits codiert.
Wenn man dabei oft vorkommende Bytes mit wenigen Bits kodiert, dann kann man damit bis zu 87% pro Byte einsparen.


Es ist aber wie überall, es kommt bei der einsparbaren Datenmenge davon abhängig, wie die zu komprimierten Daten aufgebaut sind und welcher Algo zur Komprimierung verwendet wird.

Huffman - wenn alle möglichen Bytes vorkommen und diese möglichen Bytes auch noch schön gleichverteilt sind, dann kann man mit einer Entropiekodierung nichts gut machen ... es würde eventuell sogar mehr/größer, statt kleiner/weniger.

Genauso kann an nichts mit einer Lauflängen-Kodierung ausrichten, wenn es keine/kaum gleiche aufeinanderfolgende Bytes/Zeichen gibt.




Bei großen Texten (weiß jetzt allerdings nicht, wie sich sowas nennt) könnte man auch ein Wörterbuch mit den vorkommenden Wörtern anlegen und speichert dann nur ein kurzes Ersatzmuster, für mehrfach vorkommende Wörter.

Man sucht also größere, sich gleichende Teile und speichert dann im Text nur noch Referenzen auf diese Teile.

[NickelM]

Hm...also ich glaub solangsam versteh ichs.

Hunterprozentig wie man sowas programmiert wäre mir sowieso viel zu kompliziert, da ich noch nicht soooo viuel damit gemacht haben.

Der eigentliche Grund, wie mach sowas macht war das ich bei meinem einem Programm eine AVI Datei hab die 42 MB groß ist. Die wird in einem InnoSetup eingefügt und mit lzma2/ultra komprimierung gepackt. Und was kommt raus..eine 1,62 Mb große Installationsdatei. (war natürlich nicht alles aber das Video war das größte..)

Jetzt hab ich mich gefragt, wie hat das Prog das dan gemacht??????

EDIT: Aber da AVi ja glaub ich net komprimiert ist also viele zeichenfolgen hat, wird mir das jetzt auch klar xD

[Sherlock]

Und wenn Du wirklich voll einsteigen willst, geht es hiermit los: http://de.wikipedia.org/wiki/Informationstheorie

Sherlock

[himitsu]

Jupp, das einfache Ur-AVI ist unkomprimiert und entspricht quasi einer Aneinanderreihung von vielen Bitmaps (BMP).
(heutzutage ist .avi aber nur ein Kontainer, in welchem aber ein anderes Format drinsteckt)

Wenn dir jetzt wenig Bewegung und/oder großflächig gleichfarbige Bereiche drin vorkommen, dann kann dort sehr viel und vorallem verlustlos komprimiert werden.
(die meißten Videokomprimierungen sind aber verlustbehaftet ... MPeg ist fast wie aneinandergereihte JPEGs, vn welchen auch nur die veränderten Bereiche gespeichert werden)

[NickelM]

@Sherlock : Schwere Kost..aber danke wenn ich mich mal damit befassen will mach ich dass.

Danke an allen nochmal. Habs jetzt kapiert.

[qwertz543221]

ich habe die hier angesprochene runlength-codierung in eifnacher form geschrieben. ist zzt nur für strings, kann aber einfach für streams, also dateien beliebigen formats erweitert werden.

zur besseren komprimierung möchte ich das ganze zuvor mit burrows - wheeler transformieren. ZZt wird noch die gesamte Tabelle im Speicher abgelegt, doch sollte es /auch laut wiki/ genügen nur speicheradressen auf den jeweiligen anfang zu setzen, um den prozess zu beschleunigen und eine kleinere datenmenge verwalen zu müssen.


Der algorithmus in seiner ursprungsform läuft... mir fehlt nur ein ansatz für die o.g. optimierung.(btw möglicherweise nur mit zeigern statt agnzer taBelle, wie ist das zu realisieren??)

Danke für etwaige Anmerkungen und Ergänzungen. Ich hoffe ich konnte einen kleinen anreiz geben,.

Eine kopie des qt hänge ich an

[qwertz543221]

es hat sich im qt ein fehler eingeschlichen, sodass der decoder an manchen stllen falsche codes einliest und dementsprechend keine korrekte umwandlung mehr in unkomprimierten text mehr liefert. Wieso das so ist, kann ich zzt noch nicht sagen, da es bisher nur bei nicht-text-sreams auftritt. bei texten scheint alles zu funktionieren.
Bin noch auf der suche...

[himitsu]

Zitat:

Zitat von qwertz543221 (Beitrag 1035538)

es hat sich im qt ein fehler eingeschlichen,...

Hast du eventuell vergessen deine Markierung für die Mehrfach-Angaben zu prüfen?
Wen diese im Originaltext vorkommt, dann muß diese ebenfalls kodiert werden, selbst wenn es da keine Mehrfachvorkommen gibt.

[qwertz543221]

das könnte sein... bei strings tritt das trennzeichen (chr(0))im allg nicht auf, da es den string abschließt. daher habe ich dieses zeichen gewählt.

bei anderen streams:

wie muss ich dann vorgehen, falls ich auf das trennzeichen treffe?? bisher habe ich es wie folgt gemacht:

Delphi-Quellcode:

function tform1.rledec(text:ansistring):ansistring;
var c,d:ansistring;
i,j,z:int64;

begin
//text:=base64dec(text);
//text:=strtohex(text);
result:='';
i:=1;

while i<=length(text) do
 begin
 if text[i]=chr(0)
   then
   begin
   c:='';
   j:=i+1;
   while j<=i+2 do
    begin
    c:=c+text[j];
    j:=j+1;
    end;
 // showmessage(c);
   d:=text[j];
   z:=1;
   while z<=strtoint('$'+c) do
    begin
    result:=result+d;
    z:=z+1;
    end;
   i:=i+4;
   end
    else
    begin
    result:=result+text[i];
    i:=i+1;
    end;
  end;
end;

[himitsu]

Zitat:

Zitat von qwertz543221 (Beitrag 1035577)

wie muss ich dann vorgehen, falls ich auf das trennzeichen treffe??

Man könnte hier
a) sich etwas einfallen lassen, wie man die "originalen" #0 (aka chr(0) ) maskiert, oder

b) man tut einfach so, als wäre diese 0 (irgend)ein sich wiederholendes Zeichen, welches du ja über eine #0-eingeführte Steuersequenz maskierst.
> also füge statt soeiner gefundenen #0 einfach deine Sequenz ein, welche besagt "1-mal die #0"
(falls mehrere nacheinanderfolgene Nullen vorkommen, würde es sogar wieder dem Ursprünglichen Gedanken entsprechen)

PS: das

Delphi-Quellcode:

result:=result+chr(0)+inttohex(c,2)+text[i]//+chr(32);

könnte man sogar noch weiter komprimieren, indem du es nicht als Text, sondern auch Binär behandelst.

wiederholende Char (X) als

Delphi-Quellcode:

#0 + Chr(Count) + X

und die einzelne #0 wäre dann

Delphi-Quellcode:

#0#1#0

aka

Delphi-Quellcode:

#0 + Chr(Count) + Chr(0) // count=1

ebenso mit maximal 255 Fogezeichen, wobei man sogar 256 nutzen könnte, da es die Anzahl 0 nicht gibt (0=1-mal, 1=2-mal ... 255=256-mal)
und es würden maximal immer nur 3 Byte sein, anstatt deinen aktuell mindestens 4 Byte.

[Medium]

Hatte mal eine kleine RLE gebaut mit $FF als Marker. Die "Regeln" waren da dann:

$FF = Marker: Hier nach kommt ein Byte für die Anzahl
$XX = Anzahlbyte
$YY = Byte, dass $XX mal in Folge kommt

$XX ist maximal $FE, wenn es $FF ist, heisst das, dass ein einzelnes, uncodiertes $FF da sein soll - es ist also dann im unkomprimierten Anteil einfach gedoppelt. Der Preis ist eben, dass man maximal 255 statt 256 in einen Block pressen kann. (Da kein Zeichen 0 mal wiederholt wird, hab ich zum Anzahlbyte immer +1 gezählt.)

[qwertz543221]

das bezieht sich aber schon auf die codierung, oder erst auf die decodierung?

ich nehme mal an ersteres...

bei der decodierung bekomme ich weiterhin eine fehlermeldung, die darauf hinweist, dass falsch gezählt wird.
(exception econverterror zeigt leeren hexwert an)
geändert wie folgt:

Delphi-Quellcode:

function tform1.rleenc(text:ansistring):ansistring; //RLE
var
i,c,k:int64;
begin
result:='';
i:=1;
while i<=length(text) do
begin
c:=1;
while (text[i]=text[i+1])do //and (c<254)do
begin
c:=c+1;
i:=i+1;
end;
//if (text[i]='F')
  //then  result:=result{+'FF'}+inttohex(c,2)+'00'//+chr(32)
//showmessage(inttostr(c));
if (c>4)and (text[i]=chr(0)) //hier geändert f.d. Auftreten des Steuerzeichens!!
  then result:=result+chr(0)+'01'+text[i]//+chr(32);
  else
if (c>4) and (text[i]<>chr(0))
  then  result:=result+chr(0)+inttohex(c,2)+text[i]//+chr(32);
    else
    begin
    k:=1;
    while k<=c do
    begin
    result:=result+text[i];
    k:=k+1;
    end;
    end;
i:=i+1;;
end;
//while length(result) mod 3<>0 do result:=result+'0';
//result:=hextostr(result);
//result:=base64enc(result);
end;

[qwertz543221]

Zitat:

Zitat von Medium (Beitrag 1035580)

Hatte mal eine kleine RLE gebaut mit $FF als Marker. Die "Regeln" waren da dann:

$FF = Marker: Hier nach kommt ein Byte für die Anzahl
$XX = Anzahlbyte
$YY = Byte, dass $XX mal in Folge kommt

$XX ist maximal $FE, wenn es $FF ist, heisst das, dass ein einzelnes, uncodiertes $FF da sein soll - es ist also dann im unkomprimierten Anteil einfach gedoppelt. Der Preis ist eben, dass man maximal 255 statt 256 in einen Block pressen kann. (Da kein Zeichen 0 mal wiederholt wird, hab ich zum Anzahlbyte immer +1 gezählt.)

genau dies hatte ich auch schon probiert, aber wie du bereits sagtest, ist hier das problem, maximal $FE zeichen hintereinander codieren zu können, bei vielen gleichen zeichen habe ich dadurch keine "gute" ( was ist bei rle schon gut? ;)) kompression gehabt. Aus dem grund wollte ich darauf verzichten.

Außerdem hatte ich probleme mit den flags, da ich zwischendurch noch unkomprimierten text unterbringen wollte um zu vermeiden dass FF01XXFF01XX als ergebnis herauskommt.

[himitsu]

Zitat:

(Da kein Zeichen 0 mal wiederholt wird, hab ich zum Anzahlbyte immer +1 gezählt.)

Es wird aber auch kein Zeichen 1-mal wiederholt, also wenn du den Fall von den "einmal Marker" schon mit dem doppeltem Marker abfängst.
(gut, in soeinem Fall spart man sich dann sogar jeweil 1 Byte, wenn der Marker kodiert wird) und wie oft kommt es vor, daß sich ein Zeichen mal mehr als 200 Mal wiederholt, aber selbst wenn, dann hat man damit dann immernoch eine maximale Kompressionsrate von 1/256*3 = 98,8% .

Delphi-Quellcode:

function LauflängenKodierung(S: String): String;
var
  i, a: Integer;
  c: Char;
begin
  i := 1;
  while i <= Length(S) do
    if (i < Length(S)) and (S[i] = S[i + 1]) then begin
      c := S[i];
      a := i + 1;
      while (a < Length(S)) and (S[a] = S[a + 1]) and (a - i < 256) do Inc(a);
      Dec(a, i);
      Delete(S, i, a);
      Insert(#0 + Char(a) + C, S, i);
      Inc(i, 3);
    end else if S[i] = #0 then begin
      Insert(#0#1#0, S, i + 1);
      Inc(i, 3);
    end else Inc(i);
  Result := S;
end;

function LauflängenDekodierung(S: String): String;
var
  i, a: Integer;
  c: Char;
begin
  i := 1;
  while i < Length(S) - 1 do
    if S[i] = #0 then begin
      a := Ord(S[i + 1]);
      c := S[i + 2];
      Delete(S, i, 3);
      Insert(StringOfChar(c, a), S, i);
      Inc(i, a);
    end else Inc(i);
  Result := S;
end;

(ungetestet, da nur so dahingeschrieben)

[edit]
hatte die ersten beiden Parameter beim Inset vertauscht

[Medium]

Habs auch nochmal genauer nachgeschaut, nachdem es mir nach dem Schreiben seltsam vor kam: Ich hab nur Wiederholungen ab >3x kodiert, weil die Kodierung selbst ja schon 3 Byte lang ist. Dadurch wurde beim Counter 0 zu 4. Worst-Case ist bei sowas dann natürlich "FF43FFA0FF6C..." zu kodieren.

[qwertz543221]

Das resultat hatte ich mit der vorgehensweise ( war mein initiales vorgehen) auch... daher müsste man ein nocodeflag einbauen, welches besagt, dass ab da uncodierter text kommt. dies soll sein falls die runs kleiner als die minimal sinvolle länge, oder falls FF im text vorkommt.

Da ich aber nicht in der lage war später wieder flag von text zu unterscheiden, bin ich davon wieder abgekommen...

[himitsu]

Zitat:

Zitat von qwertz543221 (Beitrag 1035586)

Da ich aber nicht in der lage war später wieder flag von text zu unterscheiden, bin ich davon wieder abgekommen...

jupp, darum muß man die Steuerzeichen, welche so im Text vorkommen können auch irgendwie mit maskieren.
Dann gibt es diese Steuerzeichen quasi nicht mehr als Text und man braucht sie nicht zu unterscheiden.



und stimmt, ab 3 Wiederholungen lohnt es sich hier erst.

hier noch eine Variante mit der Idee den Marker als doppelten Marker zu maskieren ... das erspart dort jeweils nochmal 'nen Byte.
und die 3-Zeichengrenze eingefügt

Delphi-Quellcode:

function LauflängenKodierung(S: String): String;
var
  i, a: Integer;
  c: Char;
begin
  i := 1;
  while i <= Length(S) do
    if (i < Length(S) - 1) and (S[i] = S[i + 1]) and (S[i] = S[i + 2]) then begin
      c := S[i];
      a := i + 2;
      while (a < Length(S)) and (S[a] = S[a + 1]) and (a - i < 257) do Inc(a);
      Dec(a, i);
      Delete(S, i, a);
      Insert(#0 + Char(a - 2) + C, S, i);
      Inc(i, 3);
    end else if S[i] = #0 then begin
      Insert(#0#0, S, i + 1);
      Inc(i, 2);
    end else Inc(i);
  Result := S;
end;

function LauflängenDekodierung(S: String): String;
var
  i, a: Integer;
  c: Char;
begin
  i := 1;
  while i < Length(S) - 1 do
    if S[i] = #0 then begin
      a := Ord(S[i + 1]);
      if a = 0 then begin
        Delete(S, i, 1);
        Inc(i);
      end else begin
        Inc(a, 2);
        c := S[i + 2];
        Delete(S, i, 3);
        Insert(StringOfChar(c, a), S, i);
        Inc(i, a);
      end;
    end else Inc(i);
  Result := S;
end;

Und was die Maximal 255 Zeichen angeht, welche man hier Kodieren kann ... klar, man könnte entweder die Längenangabe größer machen (z.B. 2 oder 4 Byte), aber da wäre auch die Komprimierungsrate geringer, da die Steuersequenz dann größer wäre.
oder man verwendet noch eine weitere Sequenz, mit einer größeren Anzahl, aber dafür braucht man auch wieder eine weiteres Steuerzeichen oder man verwendet einen weiteren wert aus der Sequenz1 für die größere Anzahl.

Aber da es selten vorkommt, daß sich ein Zeichen wirklich mal mehr als 255 Mal verfolgt, wird das doch eh zu selten gebraucht, also daß sich er Aufwand von einem weiteren Steuerzeichen lohnt.



hier sieht man, daß alleine die 256er-Grenze schon etwas mehr Aufwand bedarf:

Delphi-Quellcode:

function LauflängenKodierung(S: String): String;
var
  i, a: Integer;
  c: Char;
begin
  i := 1;
  while i <= Length(S) do
    if (i < Length(S) - 1) and (S[i] = S[i + 1]) and (S[i] = S[i + 2]) then begin
      c := S[i];
      a := i + 2;
      while (a < Length(S)) and (S[a] = S[a + 1]) and (a - i < 65536+255) do Inc(a);
      Dec(a, i);
      Delete(S, i, a);
      if a < 255 then begin
        Insert(#0 + Char(a - 2) + C, S, i);
        Inc(i, 3);
      end else begin
        Insert(#0#255 + Char((a - 258) div 256) + Char((a - 258) mod 256) + C, S, i);
        Inc(i, 5);
      end;
    end else if S[i] = #0 then begin
      Insert(#0#0, S, i + 1);
      Inc(i, 2);
    end else Inc(i);
  Result := S;
end;

function LauflängenDekodierung(S: String): String;
var
  i, a: Integer;
  c: Char;
begin
  i := 1;
  while i < Length(S) - 1 do
    if S[i] = #0 then begin
      a := Ord(S[i + 1]);
      if a = 0 then begin
        Delete(S, i, 1);
        Inc(i);
      end else if a < 255 then begin
        Inc(a, 2);
        c := S[i + 2];
        Delete(S, i, 3);
        Insert(StringOfChar(c, a), S, i);
        Inc(i, a);
      end else begin
        a := Ord(S[i + 2]) * 256 + Ord(S[i + 3]) + 258;
        c := S[i + 4];
        Delete(S, i, 5);
        Insert(StringOfChar(c, a), S, i);
        Inc(i, a);
      end;
    end else Inc(i);
  Result := S;
end;

[qwertz543221]

Zitat:

Zitat von himitsu (Beitrag 1035588)

Zitat:

Zitat von qwertz543221 (Beitrag 1035586)

Da ich aber nicht in der lage war später wieder flag von text zu unterscheiden, bin ich davon wieder abgekommen...

jupp, darum muß man die Steuerzeichen, welche so im Text vorkommen können auch irgendwie mit maskieren.
Dann gibt es diese Steuerzeichen quasi nicht mehr als Text und man braucht sie nicht zu unterscheiden.



und stimmt, ab 3 Wiederholungen lohnt es sich hier erst.

hier noch eine Variante mit der Idee den Marker als doppelten Marker zu maskieren ... das erspart dort jeweils nochmal 'nen Byte.
und die 3-Zeichengrenze eingefügt

Delphi-Quellcode:

function LauflängenKodierung(S: String): String;
var
  i, a: Integer;
  c: Char;
begin
  i := 1;
  while i <= Length(S) do
    if (i < Length(S) - 1) and (S[i] = S[i + 1]) and (S[i] = S[i + 2]) then begin
      c := S[i];
      a := i + 2;
      while (a < Length(S)) and (S[a] = S[a + 1]) and (a - i < 257) do Inc(a);
      Dec(a, i);
      Delete(S, i, a);
      Insert(#0 + Char(a - 2) + C, S, i);
      Inc(i, 3);
    end else if S[i] = #0 then begin
      Insert(#0#0, S, i + 1);
      Inc(i, 2);
    end else Inc(i);
  Result := S;
end;

function LauflängenDekodierung(S: String): String;
var
  i, a: Integer;
  c: Char;
begin
  i := 1;
  while i < Length(S) - 1 do
    if S[i] = #0 then begin
      a := Ord(S[i + 1]);
      if a = 0 then begin
        Delete(S, i, 1);
        Inc(i);
      end else begin
        Inc(a, 2);
        c := S[i + 2];
        Delete(S, i, 3);
        Insert(StringOfChar(c, a), S, i);
        Inc(i, a);
      end;
    end else Inc(i);
  Result := S;
end;

Und was die Maximal 255 Zeichen angeht, welche man hier Kodieren kann ... klar, man könnte entweder die Längenangabe größer machen (z.B. 2 oder 4 Byte), aber da wäre auch die Komprimierungsrate geringer, da die Steuersequenz dann größer wäre.
oder man verwendet noch eine weitere Sequenz, mit einer größeren Anzahl, aber dafür braucht man auch wieder eine weiteres Steuerzeichen oder man verwendet einen weiteren wert aus der Sequenz1 für die größere Anzahl.

Aber da es selten vorkommt, daß sich ein Zeichen wirklich mal mehr als 255 Mal verfolgt, wird das doch eh zu selten gebraucht, also daß sich er Aufwand von einem weiteren Steuerzeichen lohnt.



hier sieht man, daß alleine die 256er-Grenze schon etwas mehr Aufwand bedarf:

Delphi-Quellcode:

function LauflängenKodierung(S: String): String;
var
  i, a: Integer;
  c: Char;
begin
  i := 1;
  while i <= Length(S) do
    if (i < Length(S) - 1) and (S[i] = S[i + 1]) and (S[i] = S[i + 2]) then begin
      c := S[i];
      a := i + 2;
      while (a < Length(S)) and (S[a] = S[a + 1]) and (a - i < 65538) do Inc(a);
      Dec(a, i);
      Delete(S, i, a);
      if a < 255 then begin
        Insert(#0 + Char(a - 2) + C, S, i);
        Inc(i, 3);
      end else begin
        Insert(#0#255 + Char((a - 2) div 256) + Char((a - 2) mod 256) + C, S, i);
        Inc(i, 5);
      end;
    end else if S[i] = #0 then begin
      Insert(#0#0, S, i + 1);
      Inc(i, 2);
    end else Inc(i);
  Result := S;
end;

function LauflängenDekodierung(S: String): String;
var
  i, a: Integer;
  c: Char;
begin
  i := 1;
  while i < Length(S) - 1 do
    if S[i] = #0 then begin
      a := Ord(S[i + 1]);
      if a = 0 then begin
        Delete(S, i, 1);
        Inc(i);
      end else if a < 255 then begin
        Inc(a, 2);
        c := S[i + 2];
        Delete(S, i, 3);
        Insert(StringOfChar(c, a), S, i);
        Inc(i, a);
      end else begin
        a := Ord(S[i + 2]) * 256 + Ord(S[i + 3]) + 2;
        c := S[i + 4];
        Delete(S, i, 5);
        Insert(StringOfChar(c, a), S, i);
        Inc(i, a);
      end;
    end else Inc(i);
  Result := S;
end;

Ich wäre fast der meinung, dass er bei der codierung in eine endlosscleife kommt, jedenfalls wird das programm bei mir nicht terminiert, wenn ich zb ein 270kb bild in den stream lade. bei Textdateien geht es jedoch

[himitsu]

doch mal getestet:
die Längenberechnung war erstmal falsch, so daß da zuwenig gelöscht wurde und es bei mehrfachen #0 dann zur Endlosschleife kam, da die #0 immer wieder eingefügt wurde.

- AnsiString, wegen den Unicode-Delphis und da es hier für einen "Byte-Stream" verwendet wird
-

Delphi-Quellcode:

Dec(a, i);

, zur Längenberechnung war falsch ... mußte

Delphi-Quellcode:

Dec(a, i - 1);

sein
- und dann noch so einige andere Kleinigkeiten

Delphi-Quellcode:

function LauflängenKodierung(S: AnsiString): AnsiString;
var
  i, a: Integer;
  c: AnsiChar;
begin
  i := 1;
  while i <= Length(S) do
    if (i < Length(S)) and (S[i] = S[i + 1]) then begin
      c := S[i];
      a := i + 1;
      while (a < Length(S)) and (c = S[a + 1]) and (a - i < 65790) do Inc(a);
      Dec(a, i - 1);
      if (a < 4) and (c <> #0) then begin
        Inc(i, a);
        Continue;
      end;
      Delete(S, i, a);
      if a < 256 then begin
        Insert(#0 + AnsiChar(a - 1) + C, S, i);
        Inc(i, 3);
      end else begin
        Dec(a, 256);
        Insert(#0#255 + AnsiChar(a div 256) + AnsiChar(a mod 256) + C, S, i);
        Inc(i, 5);
      end;
    end else if S[i] = #0 then begin
      Insert(#0, S, i);
      Inc(i, 2);
    end else Inc(i);
  Result := S;
end;

function LauflängenDekodierung(S: AnsiString): AnsiString;
var
  i, a: Integer;
  c: AnsiChar;
begin
  i := 1;
  while i < Length(S) do
    if S[i] = #0 then begin
      a := Ord(S[i + 1]);
      if a = 0 then begin
        Delete(S, i, 1);
        Inc(i);
      end else if a < 255 then begin
        Inc(a);
        c := S[i + 2];
        Delete(S, i, 3);
        Insert(StringOfChar(c, a), S, i);
        Inc(i, a);
      end else begin
        a := Ord(S[i + 2]) * 256 + Ord(S[i + 3]) + 256;
        c := S[i + 4];
        Delete(S, i, 5);
        Insert(StringOfChar(c, a), S, i);
        Inc(i, a);
      end;
    end else Inc(i);
  Result := S;
end;

procedure TForm5.FormCreate(Sender: TObject);
var S: TStream;
  A, B, C: AnsiString;
begin
  S := TFileStream.Create('test.bmp', fmOpenRead or fmShareDenyNone);
  SetLength(A, S.Size);
  S.ReadBuffer(A[1], S.Size);
  S.Free;

  B := LauflängenKodierung(A);
  C := LauflängenDekodierung(B);

  ShowMessage(Format('%d=%d (%d) ... %d (%.1n%%)',
    [Length(A), Length(C), Ord(A = C), Length(B), Length(B) / Length(A) * 100]));
end;

[qwertz543221]

Danke hat super funktioniert.

Zum besseren einsatz wäre es vlt günstig, vorher burrows wheeler transofrmation anzuwenden, damit auch längere runs zustandekommen
Dazu habe ich eine textversion, die allerdings noch mit der kompletten trasnspositionstabelle arbeitet. eine möglichkeit, das ganze speichersparend auf zeiger umzustellen habe ich noch nicht, da ich nicht weiß, wie ich diese tabelle dann sortieren soll.

[qwertz543221]

zum sortieren( kopiert und verschoben etc) wird, habe ich das - langsame, aber stabile ( reicht für den anfang) - bubblesort genutzt.

ich habe jetzt das ganze versucht, über positions indizes laufen zu lassen, damit nie die gesamte tabelle verändert wird, sondern lediglich indizes geändert werden.(so wird es in wiki ja als evrbesserung dargestellt)

Am ende wird die neue anordnung anhand der vergebenen indizes in eine neue tabelle eingetragen...
... soviel zur idee, in der umsetzung des decoders kommt es dabei zu einem stack-überlauf,falls nicht nur gleiche werte in der tabelle. liegt wohl an einer nicht terminierten schleife???

Delphi-Quellcode:

function tform1.bubblesort(ar: arr):arr;

var i:int64;
c:integer;
br:arr;
begin
i:=1;
mathe:=tmathe.create;
while i<length(ar) do
begin
ar[i].position:=i;
i:=i+1;
end;

i:=1;       //über indizes sortieren
while i<length(ar) do
 begin
 if mathe.Vergleich(ar[i-1].numbers,ar[i].numbers)>0
 then
   begin
   c:=ar[i-1].position;
   ar[i-1].position:=ar[i].position;
   ar[i].position:=c;
   end;
 i:=i+1;
 end;
i:=1;
br:=ar;

while i<length(br) do
begin
ar[i].text:=br[ar[i].position].text;
ar[i].numbers:=br[ar[i].position].numbers;
i:=i+1;
end;

i:=1;     //überprüfen
while i<length(ar)do
 begin
 if vergleich(ar[i-1].numbers,ar[i].numbers)=0
  then bubblesort(ar)
    else i:=i+1;
 end;
 result:=ar;
 end;

[qwertz543221]

ok habe einen fehler gefunden. es läuft jetzt.

Habe nur ein problem des speichers, da der arbeitspeicher voll sein soll - oder ich habe einen stack-überlauf - wie bekomme ich dies beseitigt? (rekursionsporblem??)

Delphi-Quellcode:

function tform1.bubblesort(var ar: arr):arr;

var i,c:int64;

begin
i:=1;
setlength(result,length(ar));

while i<length(ar) do
 begin
 if mathe.Vergleich(ar[i-1].numbers,ar[i].numbers)>0
  then
  begin
  c:=ar[i-1].position;
  ar[i-1].position:=ar[i].position;
  ar[i].position:=c;
  end;
 i:=i+1;
 end;

i:=0;
while i<length(ar) do
 begin
 //showmessage(inttostr(ar[i].position));
 result[i]:=ar[ar[i].position];
 i:=i+1;
 end;

i:=0;
while i<length(result)-1 do
 begin
 if mathe.vergleich(result[i].numbers,result[i+1].numbers)>0
  then 
   begin
   //showmessage(inttostr(i));
   result:=bubblesort(result);
   i:=i+1;
   end;
 i:=i+1;
 end;

 end;

ich denke es wäre vlt besser, mit verketteten listen und zeigern zu arbeiten,(ich hoffe, da hab ich dann kein speicherproblem mehr?) das mit dem array ist nur eine übergangslösung.

[alzaimar]

Bubblesort in rekursiv? Das ist ja mutig. :shock:

Wieso nicht einfach so?

Delphi-Quellcode:

For i := low(TheArray) to High (TheArray)-1 do
  For j := i + 1 to High(TheArray) do
    If TheArray[i] > TheArray[j] then
      SwapArrayElements (TheArray, i, j);

Getippt und nicht getestet, und SwapArrayElements solltest Du dann noch selbst auskodieren.

Aber was Du genau sortieren willst, habe ich nicht verstanden.