Mit dieser UDF kann man einen String per Huffman-Kodierung kodieren bzw. komprimieren.
Die Huffmantabelle wird hierbei ebenso Bestandtteil des kodierten Binaries, weswegen die kanonische Form der Huffmantabelle verwendet wird um den Overhead hierfür möglichst klein zu halten.
Die UDF macht regen Gebrauch der integrierten UDF "BinaryHelpers.au3", welche Funktionen zum leichteren Umgang mit binären Daten in AutoIt enthält.
Diese wurde bislang noch nicht gesondert von mir veröffentlicht und könnte für manchen auch alleine interessant sein.
Wie verwendet man die UDF?
folgendes Beispiel:
#include "Huffman.au3"
; lese den Quellcode der Seite autoitscript.com
Global $sString = BinaryToString(InetRead("https://autoitscript.com"))
ConsoleWrite("Original Size: " & BinaryLen(StringToBinary($sString)) & " Bytes" & @CRLF)
; kodiere den String per Huffman-Kodierung
Global $bEncoded = _huff_encodeString($sString)
ConsoleWrite("Encoded Size: " & BinaryLen($bEncoded) & " Bytes" & @CRLF & _
"Compress ratio: " & Round((1 - (BinaryLen($bEncoded) / BinaryLen(StringToBinary($sString)))) * 100.0, 1) & ' %' & @CRLF)
; dekodiere den String wieder aus dem Binary
Global $sStringDecoded = _huff_decodeBinary($bEncoded)
; Prüfe ob der Originalstring und der dekodierte String gleich sind
ConsoleWrite("$sString == $sStringDecoded: " & ($sString == $sStringDecoded) & @CRLF)
Alles anzeigen
erbringt folgende Ergebnisse:
Original Size: 157081 Bytes
Encoded Size: 102833 Bytes
Compress ratio: 34.5 %
$sString == $sStringDecoded: True
Wie kann man die Komprimierungsrate noch weiter steigern?
Die Huffmankodierung ist nur ein von mehreren möglichen Beispiel zur Komprimierung von Daten und kann mit diesen auch kombiniert werden.
Wenn man z.B. den String erst auf Textebene vorkomprimiert (z.B. durch Wortwiederholungskomprimierung) und erst anschließend die Huffmankodierung darüber gießt, kann man sich seinen eigenen kleinen Komprimierer komplett in AutoIt schreiben.
Das obere Beispiel habe ich mal um eine solche (simple!) Vorkomprimierung ergänzt:
#include "Huffman.au3"
; read out the autoitscript.com page as example string
Global $sString = BinaryToString(InetRead("https://autoitscript.com"))
ConsoleWrite("Original Size: " & BinaryLen(StringToBinary($sString)) & " Bytes" & @CRLF)
; precompress at text level by word repetition:
Global $sStringCompressed = _strcmp_compressByWordRepetition($sString)
; encode the string with a canonical huffman encoding
Global $bEncoded = _huff_encodeString($sStringCompressed)
ConsoleWrite("Encoded Size: " & BinaryLen($bEncoded) & " Bytes" & @CRLF & _
"Compress ratio: " & Round((1 - (BinaryLen($bEncoded) / BinaryLen(StringToBinary($sString)))) * 100.0, 1) & ' %' & @CRLF)
; decode the string out of the binary
Global $sStringDecoded = _huff_decodeBinary($bEncoded)
; decompress at text level
$sStringDecoded = _strcmp_decompressByWordRepetition($sStringDecoded)
; check if original and decoded string are the same
ConsoleWrite("$sString == $sStringDecoded: " & ($sString == $sStringDecoded) & @CRLF)
; Tokenbasierte Kompression - ersetzt wiederholende Teile durch Nummern im Text
Func _strcmp_compressByWordRepetition($sString)
Local $mTmp[3], $aTmp[2], $mPos, $iLen, _
$mWords[], _
$iPos = 1, _
$sWord, $iWord = 0
; Bereits vorhandene Präfixnummern escapen:
$sString = StringRegExpReplace($sString, '(?s)\b(\d+)', Chr(27) & "$1")
; Einzelne Wörter aus dem String extrahieren
Do
$aMatch = StringRegExp($sString, '(?s)\G.*?(\b[a-zA-ZäöüßÄÖÜ][\wäöüßÄÖÜ]{2,}\b)', 1, $iPos)
IF @error Then ExitLoop
$iPos = @extended
$sWord = $aMatch[0]
If MapExists($mWords, $sWord) Then
$aTmp = $mWords[$sWord]
$mTmp = $aTmp[1]
MapAppend($mTmp, $iPos - StringLen($sWord))
$aTmp[1] = $mTmp
Else
Local $mTmp[]
Local $aTmp[2] = [$iWord, $mTmp]
EndIf
$mWords[$sWord] = $aTmp
$iWord += 1
Until 0
; bereite die notwendigen Replaces auf
Local $aReplaces[$iWord][3], $iIndRepl = 0
For $sWord In MapKeys($mWords)
$iLen = StringLen($sWord)
$aTmp = $mWords[$sWord]
$iWord = $aTmp[0]
$mPos = $aTmp[1]
If Ubound($mPos) < 1 Then ContinueLoop
If $iLen <= Stringlen($iWord) Then ContinueLoop
For $i In MapKeys($mPos)
$iPos = $mPos[$i]
$aReplaces[$iIndRepl][0] = $iPos
$aReplaces[$iIndRepl][1] = $iLen
$aReplaces[$iIndRepl][2] = $iWord
$iIndRepl += 1
Next
Next
Redim $aReplaces[$iIndRepl][3]
_ArraySort($aReplaces)
; Wörter durch Nummern im Text selbst ersetzen
For $i = UBound($aReplaces) - 1 To 0 Step -1
$sString = StringLeft($sString, $aReplaces[$i][0] - 1) & _
$aReplaces[$i][2] & _
StringTrimLeft($sString, $aReplaces[$i][0] + $aReplaces[$i][1] -1)
Next
Return $sString
EndFunc
; Tokenbasierte Dekompression - stellt einen mit _strcmp_compressByWordRepetition() komprimierten String wieder her
Func _strcmp_decompressByWordRepetition($sString)
Local $aTmp[3], _
$mWords[]
$iPos = 1
; Einzelne Wörter aus dem String extrahieren
Do
$aMatch = StringRegExp($sString, '(?s)\G.*?(\b[a-zA-ZäöüßÄÖÜ][\wäöüßÄÖÜ]{2,}\b|\b(?<!\x1B)\d+\b)', 1, $iPos)
IF @error Then ExitLoop
$iPos = @extended
$aTmp[0] = $aMatch[0]
$aTmp[1] = $iPos - StringLen($aMatch[0])
$aTmp[2] = StringLen($aMatch[0])
MapAppend($mWords, $aTmp)
Until 0
Local $aWords = _map_IntMap2Array($mWords)
$aWords = _ArrayAinATo2d($aWords)
; Nummern wieder durch Buchstaben ersetzen
Local $iWord
For $i = UBound($aWords) - 1 To 0 Step -1
If Not StringRegExp($aWords[$i][0], "^\d+$", 0) Then ContinueLoop
$iWord = Int($aWords[$i][0])
If $iWord >= UBound($aWords) Then ContinueLoop
;~ ConsoleWrite($iWord & @CRLF)
$sString = StringLeft($sString, $aWords[$i][1] - 1) & _
$aWords[$iWord][0] & _
StringTrimLeft($sString, $aWords[$i][1] + $aWords[$i][2] -1)
Next
; Escapte Zahlen wieder unescapen:
$sString = StringRegExpReplace($sString, '(?s)\x1B(\d+)', "$1")
Return $sString
EndFunc
; #FUNCTION# ======================================================================================
; Name ..........: _map_IntMap2Array()
; Description ...: returns the values of a map only (useful for array-list like maps produced by MapAppend())
; Syntax ........: _map_IntMap2Array(ByRef $aMap)
; Parameters ....: ByRef $aMap - a map variable
; Return values .: 1D-array containing the values
; Author ........: aspirinjunkie
; Modified ......: 2022-07-13
; =================================================================================================
Func _map_IntMap2Array(ByRef $aMap)
Local $aRet[UBound($aMap)]
Local $iInd = 0
For $vEl In $aMap
$aRet[$iInd] = $vEl
$iInd += 1
Next
Return $aRet
EndFunc ;==>_map_IntMap2Array
; #FUNCTION# ======================================================================================
; Name ..........: _ArrayAinATo2d()
; Description ...: Convert a Arrays in Array into a 2D array
; Syntax ........: _ArrayAinATo2d(ByRef $A)
; Parameters ....: $A - the arrays in array which should be converted
; Return values .: Success: a 2D Array build from the input array
; Failure: Null
; @error = 1: $A is'nt an 1D array
; = 2: $A is empty
; = 3: first element isn't a array
; Author ........: AspirinJunkie
; =================================================================================================
Func _ArrayAinATo2d(ByRef $A)
If UBound($A, 0) <> 1 Then Return SetError(1, UBound($A, 0), Null)
Local $N = UBound($A)
If $N < 1 Then Return SetError(2, $N, Null)
Local $u = UBound($A[0])
If $u < 1 Then Return SetError(3, $u, Null)
Local $a_Ret[$N][$u]
For $i = 0 To $N - 1
Local $t = $A[$i]
If UBound($t) > $u Then ReDim $a_Ret[$N][UBound($t)]
For $j = 0 To UBound($t) - 1
$a_Ret[$i][$j] = $t[$j]
Next
Next
Return SetExtended($N, $a_Ret)
EndFunc ;==>_ArrayAinATo2d
Alles anzeigen
und hiermit erhalten wir nun folgende Ergebnisse: