Kontakt
DSVGO
Im Folgenden wird die "RLE-Komprimierung mit Läufen" vorgestellt, Problemfälle diskutiert und schließlich der ausprogrammierte VB-Code präsentiert.
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:
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.
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:
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.
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).
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
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
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":
'©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
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
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
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
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
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
© Jost Schwider, 05.05.2005-05.05.2005 - http://vb-tec.de/rle-lauf.htm