VB-Tec / Workshops / RLE / Lauf - RLE-Komprimierung mit Läufen

Ein anderes RLE-Prinzip

Im Folgenden wird die "RLE-Komprimierung mit Läufen" vorgestellt, Problemfälle diskutiert und schließlich der ausprogrammierte VB-Code präsentiert.

Idee: Kein extra Markierungsbyte

Die bisher vorgestellten RLE-Verfahren benutzten immer ein zusätzliches Markierungsbyte, um eine kommende Sequenz von gleichen Zeichen anzukündigen; es folgen dann ein Byte für die Anzahl der Wiederholungen und ein Byte für das eigentliche Zeichen (eine solche Sequenz kostet also 3 Bytes). Daher kann es Einsparungen nur dann geben, wenn überhaupt mehr als 3 gleiche Zeichen aufeinanderfolgen.

Man kann das RLE-Verfahren jedoch derart modifizieren, dass ein zusätzliches Markierungsbyte nicht mehr benötigt wird: Dazu wird die Information, dass jetzt eine komprimierte Zeichenfolge kommt, in die Anzahl der Wiederholungen hineincodiert (indem das höchste Bit gesetzt wird). Da man nun aber dieses so erhaltene "Kommando-Byte" nicht mehr von einem normalen (nicht wiederholten) Zeichen unterscheiden kann, müssen die nicht-komprimierten Zeichenfolgen ebenfalls durch ein solches Kommando-Byte angekündigt werden, welches eben die Anzahl der nachfolgenden ungleichen Zeichen angibt.

Es entsteht also eine Folge von sogenannten "Läufen", welche es in 2 Ausprägungen gibt:

Kopierlauf: Kommando-Byte n aus 0..127 bedeutet, dass die n+1 nachfolgenden Zeichen kopiert werden müssen.
Komprimierlauf: Kommando-Byte n aus 129..255 bedeutet, dass das nachfolgende Zeichen 257-n mal kopiert werden muss.

Beispiel

Im folgenden Beispiel wird ein 9 Zeichen langer String auf 8 Zeichen komprimiert:

s = RLEEncode("AAABCDEEE")
'ergibt [254]A(2)BCD[254]E

Zur Notation der Kommando-Bytes: Eckige Klammern kündigen einen Komprimierlauf an (Wert von 257 abziehen), runde Klammern dagegen einen Kopierlauf (Wert um 1 erhöhen).

Man beachte, dass die bisherigen Verfahren (auch mit optimalen Markierungsbyte!) keine Komprimierung erbracht hätten.

Problemfall / Optimierung

Da jede Folge von ungleichen Zeichen jetzt ebenfalls durch ein Kommando-Byte angekündigt werden muss, kann dadurch u.U. eine ungewollte Verlängerung entstehen, etwa wie bei diesem Beispiel:

s = RLEEncode("CCCCABBABBABBABB")
'ergäbe [253]C(0)A[255]B(0)A[255]B(0)A[255]B(0)A[255]B

Aus einem Text von 16 Zeichen sind 18 Bytes entstanden! Das Problem ist hier, dass einzelne ungleiche Zeichen jedesmal durch ein eigenes Kommando-Byte [0] angekündigt werden müssen, obwohl dahinter "nur" eine Folge von 2 gleichen Zeichen folgt. (Da eine Folge von 3 gleichen Zeichen schon eine echte Einsparung bringt, ist dieses Problem tatsächlich nur für 2 gleiche Bytes relevant.)

Nun könnte man pauschal sagen, dass eben nur Zeichenfolgen komprimiert werden, wenn mindestens 3 gleiche Zeichen aufeinander folgen. Doch auch dies ist nicht immer optimal, wie folgendes Beispiel zeigt:

s = RLEEncode("CCCCAABBAABB")
'ergäbe [253]C(7)AABBAABB

Aus einem Text von 12 Zeichen wären dann 11 Bytes geworden. Bei Komprimierung auch der 2er Duplikate würden dagegen schon 10 Bytes reichen:

s = RLEEncode("CCCCAABBAABB")
'ergibt [253]C[255]A[255]B[255]A[255]B

Die Lösung kann also nur lauten, 2er-Folgen von gleichen Zeichen - je nach konkretem Fall - unterschiedlich zu kodieren:

Als Kopierlauf, wenn bereits ein Kopierlauf angefangen wurde und noch Platz für diese beiden Zeichen ist;
sonst als Komprimierlauf (der Länge 2).

Hier ein Beispiel für die unterschiedliche Kodierung von 2er-Folgen innerhalb eines Strings:

s = RLEEncode("AAABBCCDEE")
'ergibt [254]A[255]B[255]C(2)DEE

Der Teilstring "EE" wurde also nicht komprimiert, sondern einfach an den Kopierlauf ab "D" angehängt.

Vergleich der RLE-Verfahren

Die folgende Routine liest die Binärdatei "Explorer.exe" ein und gibt im Direktfenster die prozentuale Rate der Komprimierung an:

Sub Test()

  Dim FileNr As Long
  Dim Data() As Byte
  Dim RLE() As Byte
  Dim Markierung As Byte
  Dim n As Long
  Dim p As Single

  'Datei laden:
  FileNr = FreeFile
  Open Environ$("windir") & "\Explorer.exe" For Binary As #FileNr
    n = LOF(FileNr)
    ReDim Data(1 To n)
    Get FileNr, , Data
  Close #FileNr
  
  'Komprimierung mit "0" als Markierungs-Byte:
  RLECompressPrinzip Data(), RLE(), 0
  On Error Resume Next
    p = 1 - UBound(RLE) / UBound(Data)
    If Err.Number Then p = 0
  On Error GoTo 0
  Debug.Print "Byte 0:", Format$(p, "0.0%")
  
  'Komprimierung mit optimalem Markierungs-Byte:
  Markierung = RLEGetBestByte(Data)
  RLECompressPrinzip Data(), RLE(), Markierung
  On Error Resume Next
    p = 1 - UBound(RLE) / UBound(Data)
    If Err.Number Then p = 0
  On Error GoTo 0
  Debug.Print "OptByte:", Format$(p, "0.0%")
  
  'Komprimierung mit Läufen:
  RLE = RLEEncode(Data)
  p = 1 - UBound(RLE) / UBound(Data)
  Debug.Print "Lauf:", Format$(p, "0.0%")

End Sub

Auf meinem System (Windows XP, SP2) ergeben sich übrigens folgende Werte:

Byte 0:  10,3%
OptByte: 20,7%
Lauf:    21,0%

Die neue "RLE-Komprimierung mit Läufen" spart hier also etwas mehr ein, als das bisherige Verfahren (optimales Markierungsbyte).

Code/Quelltext RLE-Komprimierung/Packen

Daten RLE-komprimieren

Die folgende Funktion analysiert den Datentyp des übergebenen Parameters und leitet den Aufruf entsprechend an die dafür zuständige typisierte Funktion weiter:

'©2005 by Jost Schwider, http://vb-tec.de/rle-lauf.htm
Public Function RLEEncode(Data As Variant) As Variant

  'Input muss ASCII-String oder Byte-Array sein:
  If VarType(Data) = vbString Then
    RLEEncode = RLEEncodeAscii((Data))
  Else
    RLEEncode = RLEEncodeBytes((Data))
  End If

End Function

ASCII-String RLE-komprimieren

Strings gemäß ASCII (8 Bit, also ohne Unicode-spezifische Zeichen!) werden durch die folgende Funktion abgedeckt. Dabei wird der String in ein Byte-Array umgewandelt, dieses Array komprimiert und anschließend wieder zurück in einen String konvertiert:

'©2005 by Jost Schwider, http://vb-tec.de/rle-lauf.htm
Public Function RLEEncodeAscii(Ascii As String) As String

  RLEEncodeAscii = StrConv(RLEEncodeBytes( _
      StrConv(Ascii, vbFromUnicode)), vbUnicode)

End Function

Byte-Array RLE-komprimieren

Die eigentliche Arbeit findet auf Byte-Ebene statt. Der Input wird in Läufe eingeteilt; je nachdem, ob es sich um einen Kopierlauf oder einen Komprimierungslauf (also aufeinanderfolgende gleiche Zeichen) handelt, wird das Kommando-Byte Cmd entsprechend gesetzt.

Man beachte die Behandlung der beiden "Sonderfälle":

Aufeinanderfolgende unterschiedliche Zeichen werden zu einem Kopierlauf zusammengefaßt.
Wurden nur 2 gleiche Zeichen entdeckt, so werden diese - falls möglich - einem ggf. bereits vorhandenem Kopierlauf angehängt.

'©2005 by Jost Schwider, http://vb-tec.de/rle-lauf.htm
Public Function RLEEncodeBytes(Bytes() As Byte) As Variant 'Bytes()

  Dim i As Long
  Dim UB As Long
  Dim RLE() As Byte
  Dim Cmd As Byte
  Dim b As Byte
  Dim n As Integer
  Dim j As Long
  Dim CmdPos As Long

  i = LBound(Bytes)
  UB = UBound(Bytes)
  ReDim RLE(0 To (UB - i + 1) * 128 \ 127 + 1)
  
  Cmd = 128
  Do Until i > UB
  
    b = Bytes(i)
    n = RLECountEqual(Bytes, b, i + 1, UB) + 1
    If n = 2 And Cmd < 126 Then
    
      'Kopierlauf verlängern (um 2 Bytes):
      Cmd = Cmd + 2
      RLE(j) = b
      RLE(j + 1) = b
      j = j + 2
      i = i + 2
    
    ElseIf n > 1 Then
    
      'Komprimierlauf:
      If Cmd < 128 Then RLE(CmdPos) = Cmd
      Cmd = 257 - n
      RLE(j) = Cmd
      RLE(j + 1) = b
      j = j + 2
      i = i + n
    
    ElseIf Cmd < 127 Then
    
      'Kopierlauf verlängern:
      Cmd = Cmd + 1
      RLE(j) = b
      j = j + 1
      i = i + 1
    
    Else
    
      'Kopierlauf beginnen:
      If Cmd < 128 Then RLE(CmdPos) = Cmd
      CmdPos = j
      Cmd = 0
      RLE(j + 1) = b
      j = j + 2
      i = i + 1
    
    End If
  
  Loop
  If Cmd < 128 Then RLE(CmdPos) = Cmd
  
  'Ergebnis formatieren:
  ReDim Preserve RLE(0 To j - 1)
  RLEEncodeBytes = RLE

End Function

Anzahl gleicher Bytes zählen

Die folgende Hilfsfunktion bestimmt (ab einer vorgegebenen Startposition) die Anzahl der aufeinanderfolgenden gleichen Zeichen. Da ein Lauf sowieso nur höchstens 128 Bytes enthalten kann, werden maximal 127 Nachfolge-Bytes betrachtet:

'©2005 by Jost Schwider, http://vb-tec.de/rle-lauf.htm
Private Function RLECountEqual( _
    Bytes() As Byte, ByVal b As Byte, _
    ByVal Start As Long, ByVal Stopp As Long _
  ) As Integer

  Dim i As Long

  'Maximal 127 Bytes untersuchen:
  If Stopp > Start + 126 Then Stopp = Start + 126
  
  'Los gehts:
  For i = Start To Stopp
    If Bytes(i) <> b Then Exit For
  Next i
  RLECountEqual = i - Start

End Function

Code/Quelltext RLE-Dekomprimierung/Entpacken

RLE-Daten entpacken

Die folgende Funktion analysiert den Datentyp des übergebenen Parameters und leitet den Aufruf entsprechend an die dafür zuständige typisierte Funktion weiter:

'©2005 by Jost Schwider, http://vb-tec.de/rle-lauf.htm
Public Function RLEDecode(RLE As Variant) As Variant

  'Input muss String oder Byte-Array sein:
  If VarType(RLE) = vbString Then
    RLEDecode = RLEDecodeAscii((RLE))
  Else
    RLEDecode = RLEDecodeBytes((RLE))
  End If

End Function

RLE-String entpacken

ASCII-Strings werden durch die folgende Funktion abgedeckt. Dabei wird der String in ein Byte-Array umgewandelt, dieses Array entpackt und anschließend wieder zurück in einen String konvertiert:

'©2005 by Jost Schwider, http://vb-tec.de/rle-lauf.htm
Public Function RLEDecodeAscii(RLE As String) As String

  RLEDecodeAscii = StrConv(RLEDecodeBytes(StrConv( _
      RLE, vbFromUnicode)), vbUnicode)

End Function

RLE-Bytes entpacken

Die eigentliche Arbeit findet wieder auf Byte-Ebene statt. Der Input wird Kommando-Byte für Kommando-Byte analysiert; je nachdem, ob es sich um einen Kopierlauf (Wert < 128) oder einen Komprimierungslauf (Wert > 128, also höchstes Bit gesetzt) handelt, wird die entsprechende Anzahl Bytes in das Zielarray kopiert/vervielfältigt.

Hier gibt es einen Sonderfall: Ein Kommando-Byte mit dem Wert 128 gilt als Ende-Markierung und bricht die Dekomprimierung vorzeitig ab:

'©2005 by Jost Schwider, http://vb-tec.de/rle-lauf.htm
Public Function RLEDecodeBytes(RLE() As Byte) As Variant 'Bytes()

  Dim n As Long
  Dim Bytes() As Byte
  Dim i As Long
  Dim UB As Long
  Dim b As Byte
  Dim j As Long

  n = RLEDecodeLength(RLE)
  ReDim Bytes(0 To n - 1)
  
  i = LBound(RLE)
  UB = UBound(RLE)
  Do Until i > UB
  
    b = RLE(i)
    If b And &H80 Then
    
      'Ende-Markierung:
      If b = 128 Then Exit Do
      
      'Komprimierter Lauf:
      n = 257 - b
      b = RLE(i + 1)
      For j = j To j + n - 1
        Bytes(j) = b
      Next j
      i = i + 2
    
    Else
    
      'Kopierter Lauf:
      n = b + 1
      For i = i + 1 To i + n
        Bytes(j) = RLE(i)
        j = j + 1
      Next i
    
    End If
  
  Loop
  RLEDecodeBytes = Bytes

End Function

Dekomprimierungsgröße berechnen

Die folgende Hilfsfunktion geht in einem RLE-komprimierten Byte-Array schnell alle Kommando-Bytes durch, um dadurch die Gesamtlänge des entpackten Arrays zu bestimmen:

'©2005 by Jost Schwider, http://vb-tec.de/rle-lauf.htm
Private Function RLEDecodeLength(RLE() As Byte) As Long

  Dim i As Long
  Dim UB As Long
  Dim b As Byte

  i = LBound(RLE)
  UB = UBound(RLE)
  Do Until i > UB
  
    b = RLE(i)
    If b And &H80 Then
    
      'Ende-Markierung:
      If b = 128 Then Exit Do
      
      'Komprimierter Lauf:
      RLEDecodeLength = RLEDecodeLength + (257 - b)
      i = i + 2
    
    Else
    
      'Kopierter Lauf:
      RLEDecodeLength = RLEDecodeLength + (b + 1)
      i = i + 2 + b
    
    End If
  
  Loop

End Function

VB-Tec.de Visual Basic - Technik, FAQ, Tricks, Beispiele

RLE-Komprimierung mit Läufen