Komprimierung : Wie geht das?

[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 von qwertz543221:

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 von himitsu:

Zitat von qwertz543221:

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
- Dec(a, i); , zur Längenberechnung war falsch ... mußte 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.

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.