Moin,
Wer bei mir eine lange Geschichte (Beginnt bei Adam und Eva) gewöhnt ist, der darf in den (verschachtelten) Archivierten Inhalt schauen und sich sattlesen 
Zu sagen bleibt:
Das Skript wurde in den letzten Tagen mehrfach verändert, es benutzt jetzt nativ Hexadezimalzahlen (also wird keine Aufwendige Umrechnung mehr gebraucht) und ist allgemein aufgeräumter. Alle Änderungen stehen im Skript im oberen Abschnitt. So ganz einfach lässt es sich leider immernoch nicht verwenden, weil ich bisher keine "schöne" Methode gefunden habe den kodierten Daten unsere Wahrscheinlichkeitstabelle mitzugeben. (selbstverständlich lässt sich das sehr leicht machen, aber es soll ja auch möglichst wenig Platz verbrauchen, darüber denke ich aktuell noch nach 
) Und es gilt wie üblich: Eine Entropiekodierung ist der LETZTE Schritt einer ernsthaften Kompression, nicht der Erste 
Die Auswirkungen verschiedener Bitraten auf verschiedene Texte kann man in Zeile 79 und 80 ausprobieren.
Arithmetische Kodierung
;~ #include <Array.au3>
; |------------------------------------------------------------------------------|
; Skript : Entropiekodierung via Arithmetischer Kodierung
; Autor : Mars (AutoIt.de)
; AutoIt : Läuft mit [3.3.10.2] keine Gewähr für frühere oder spätere Versionen
; Version : 0.13
; Changes : 0.01 - Erzeugung von Tables
; 0.02 - Kodieren (dezimal)
; 0.03 - Dekodieren (dezimal)
; 0.04 - Anständige Formatierung (so halbwegs...)
; 0.10 - Kodieren im Hexadezimalsystem
; 0.11 - Rotierendes Alphabet
; 0.12 - Rewrite einiger Funktionen, Bugfixes, 2D-Tables eingeführt
; 0.13 - Dekodieren im Hexadezimalsystem
; Issues : 0.13 - Es treten in manchen Fällen "Missverständnisse" bei den letzten
; kodierten Zeichen eines Strings im Dekodierer auf. Um dieses Problem
; zu umgehen wurde 1Hexzeichen zusätzlich angehängt (obwohl das
; theoretisch unnötig sein müsste). Ob das Problem damit erfolgreich
; umgangen wurde kann zum jetzigen Zeitpunkt nicht gesagt werden.
; |------------------------------------------------------------------------------|
; |--------------------------------Funktionsweise--------------------------------|
; # Siehe Wikipedia
; - http://de.wikipedia.org/wiki/Arithmetisches_Kodieren
; |------------------------------------------------------------------------------|
; |----------------------------------Änderungen----------------------------------|
; # Funktioniert Hexadezimal
; - Keine Umrechnung von Dec in Hex nötig !
; - Diese Rechnung war für große Zahlen aufwändiger als befürchtet...
; # Rotierendes Alphabet
; - Das Intervall kann sich nicht mehr "festfressen"
; - z.B. 0.2000 und 0.1999, wenn letzteres immer weiter erhöht
; - wird erreicht die Signifikante Ziffer trotzdem nie 2
; # Einstellbare Bitrate
; - Die Wahrscheinlichkeit für jedes Zeichen muss exakt sein um das
; - bestmögliche Ergebnis zu erzielen. In der Realität verbraucht
; - die Wahrscheinlichkeitstabelle die den kodierten Daten hinzugefügt
; - werden muss einiges an Platz. Daher kann den Wahrscheinlichkeiten
; - eine Bitrate zugeteilt werden. Das Ergebnis wird somit besser.
; - Kleine Datenmengen profitieren von der kleinen Tabelle, und
; - für große Datenmengen reicht die Genauigkeit von 16 Bit aus um
; - ohne Kompressionsverluste zu arbeiten.
; |------------------------------------------------------------------------------|
; Gewöhnlicher Text (selbst verfasst, und daher frei von jeglichen Copyrights)
Global $sText1 = _
'Hallo, ich will komprimiert werden. Das gefällt ' & _
'mir sehr gut. Sehr Schön, Ciao ! Sowas könnte ic' & _
'h den ganzen lieben langen Tag machen. Da wird j' & _
'a der Hund in der Pfanne Verrückt. Sowas lasse i' & _
'ch nicht einfach durchgehen, ihr Banausen ! Da g' & _
'eht mir die Hutschnur wenn ich sowas sehe, das i' & _
'st ja nicht zum Aushalten ! Bei sowas könnte ich' & _
' mich grad vergessen. Das geht überhaupt nicht !' & _
' Wenn ich du wäre, würde ich mich was schämen :)'
; Einfach zu komprimierende Daten
Global $sText2 = _
'123456789012345678912345678123456712345612345123' & _
'412312100000000000000000000000000000000000000000' & _
'000000000000000000000000000000000000000000000000' & _
'000000000000000000000000000000000000000000000000' & _
'Das ist schön :)'
; Ein einziges sich wiederholendes Zeichen mit einem Fremdzeichen
Global $sText3 = _
'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa' & _
'aaaaaaaaaaaaoaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa' & _
'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa' & _
'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa' & _
'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa' & _
'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa' & _
'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa'
; Zum Ausprobieren bitte hier herumspielen:
Global $sText = $sText2
Global $nBitRate = 7
; Zum Ausprobieren bitte hier herumspielen:
Global $iAnz = 0
Global $sComp = '', $sDecomp = ''
ConsoleWrite(@CRLF & '-------------------------------------------------------------' & @CRLF)
$iAnz = UBound(_MComp_StringCountChars($sText))
ConsoleWrite('String -> (' & $iAnz & ')' & @CRLF & '> ' & $sText & @CRLF & 'Len: ' & StringLen($sText) & ' Byte' & @CRLF & 'Größe (gleichmäßig kodiert): ' & _MComp_StringGetInformationContent($sText) & ' Byte' & @CRLF & @CRLF)
$sComp = _MComp_StringEncode($sText, $nBitRate)
[/autoit] [autoit][/autoit] [autoit]$iAnz = UBound(_MComp_StringCountChars($sComp))
ConsoleWrite('Encode -> (' & $iAnz & ')' & @CRLF & '> ' & $sComp & @CRLF & 'Len: ' & StringLen($sComp) & ' Hex' & @CRLF & 'Größe (dynamisch kodiert): ' & _MComp_StringGetInformationContent($sComp) & ' Byte ( ' & Round(_MComp_StringGetInformationContent($sComp) / StringLen($sText), 4) * 100 & ' % )' & @CRLF & @CRLF)
$sDecomp = _MComp_StringDecode($sComp, _MComp_StringCreateTable($sText, $nBitRate), StringLen($sText))
[/autoit] [autoit][/autoit] [autoit]$iAnz = UBound(_MComp_StringCountChars($sDecomp))
ConsoleWrite('Decode -> (' & $iAnz & ')' & @CRLF & '> ' & $sDecomp & @CRLF & 'Len: ' & StringLen($sDecomp) & ' Byte' & @CRLF & 'Größe (gleichmäßig kodiert): ' & _MComp_StringGetInformationContent($sDecomp) & ' Byte' & @CRLF & @CRLF)
If $sText == $sDecomp Then
ConsoleWrite('+ Erfolg !' & @CRLF)
Else
ConsoleWrite('! ERROR !!!' & @CRLF)
EndIf
ConsoleWrite('-------------------------------------------------------------' & @CRLF)
; |------------------------------------------------------------------------------|
; | Return: Aus einer Entropiekodierung ermittelter String
; | VORSICHT, der String der Encode Funktion reicht nicht zum dekodieren aus.
; | Es wird zusätzlich ein Table in gültiger Bitrate, sowie die Länge benötigt !
; |------------------------------------------------------------------------------|
Func _MComp_StringDecode($sString, $aTable, $iLen)
Local $aInterval[2] = [0, 0xFFFFFFF], $aIntNew, $sRet, $iTmp, $iHexLeft, $iHexRight, $iHexMid
While $iLen
$iTmp = Int('0x' & StringLeft($sString & '0000000', 7))
$aIntNew = _MComp_IntervalCalcNew($aInterval, $aTable, $iLen > 1)
For $e = 0 To UBound($aIntNew) - 1 Step 1
If $iTmp < Int($aIntNew[$e][1]) Then ExitLoop
Next
;~ _ArrayDisplay($aIntNew, _MComp_HexToString(Hex($aIntNew[$e][0], 2)))
$sRet &= Hex($aIntNew[$e][0], 2)
$iLen -= 1
$aInterval[1] = Int($aIntNew[$e][1])
If Not $e = 0 Then $aInterval[0] = Int($aIntNew[$e - 1][1])
$iHexLeft = Hex(Int($aInterval[0]), 7)
$iHexRight = Hex(Int($aInterval[1]), 7)
$iHexMid = Hex(Int($iTmp), 7)
;~ ConsoleWrite($iHexLeft & '|' & $iHexMid & '|' & $iHexRight & @CRLF)
While StringLeft($iHexLeft, 1) = StringLeft($iHexRight, 1) And StringLeft($iHexLeft, 1) = StringLeft($iHexMid, 1)
$iTmp = StringLeft($iHexLeft, 1)
$sString = StringTrimLeft($sString, 1)
$aInterval[0] = ($aInterval[0] - ('0x' & $iTmp & StringLeft('0000000', StringLen($iHexLeft) - 1))) * 16
$aInterval[1] = ($aInterval[1] - ('0x' & $iTmp & StringLeft('0000000', StringLen($iHexLeft) - 1))) * 16
$iHexMid = StringLeft($sString, 7)
$iHexLeft = Hex(Int($aInterval[0]), 7)
$iHexRight = Hex(Int($aInterval[1]), 7)
WEnd
WEnd
Return _MComp_HexToString($sRet)
EndFunc ;==>_MComp_StringDecode
; |------------------------------------------------------------------------------|
; | Return: EntropieKodierung des Strings als Hexadezimalstring ohne führendes '0x'
; | Opt : Die Wahrscheinlichkeitsbitrate ist zwischen 1 und 16 frei wählbar
; | VORSICHT, die Rückgabe enthält ausschließlich den kodierten String, zur
; | Dekodierung wird weiterhin der gültige Table, sowie die Stringlänge benötogt
; |------------------------------------------------------------------------------|
Func _MComp_StringEncode($sString, $iBitrate = 0)
Local $aTable = _MComp_StringCreateTable($sString, $iBitrate), $sBin = _MComp_StringToHex($sString)
Local $aInterval = [0, 0xFFFFFFF], $sRet, $iChar, $aIntNew, $iTmp, $iHexLeft, $iHexRight
For $i = 1 To StringLen($sBin) Step 2
$iChar = Int('0x' & StringMid($sBin, $i, 2))
$aIntNew = _MComp_IntervalCalcNew($aInterval, $aTable)
For $e = 0 To UBound($aIntNew) - 1 Step 1
If $aIntNew[$e][0] = $iChar Then ExitLoop
Next
$aInterval[1] = Int($aIntNew[$e][1])
If Not $e = 0 Then $aInterval[0] = Int($aIntNew[$e - 1][1])
$iHexLeft = Hex(Int($aInterval[0]), 7)
$iHexRight = Hex(Int($aInterval[1]), 7)
;~ ConsoleWrite($iHexLeft & '|' & 0 & '|' & $iHexRight & @CRLF)
While StringLeft($iHexLeft, 1) = StringLeft($iHexRight, 1)
$iTmp = StringLeft($iHexLeft, 1)
$sRet &= $iTmp
$aInterval[0] = ($aInterval[0] - ('0x' & $iTmp & StringLeft('0000000', StringLen($iHexLeft) - 1))) * 16
$aInterval[1] = ($aInterval[1] - ('0x' & $iTmp & StringLeft('0000000', StringLen($iHexLeft) - 1))) * 16
$iHexLeft = Hex(Int($aInterval[0]), 7)
$iHexRight = Hex(Int($aInterval[1]), 7)
WEnd
Next
$iHexLeft = Hex(Int($aInterval[0]), 7)
$iHexRight = Hex(Int($aInterval[1]), 7)
Return $sRet & Hex(Int(Round((Int('0x' & StringLeft($iHexLeft, 1)) + Int('0x' & StringLeft($iHexRight, 1))) / 2, 0)), 1)
EndFunc ;==>_MComp_StringEncode
; |------------------------------------------------------------------------------|
; | Return: 1D-Table mit Wahrscheinlichkeiten zwischen 0 und 2^n-1
; | ByRef : 1D-Table mit Wahrscheinlichkeiten zwischen 0 und 1
; | Opt : Die Wahrscheinlichkeitsbitrate ist zwischen 1 und 16 frei wählbar
; |------------------------------------------------------------------------------|
Func _MComp_TableCompress(ByRef $aTable, $iBitrate)
If Not $iBitrate Or $iBitrate > 16 Then Return SetError(1, 0, $aTable)
Local $iMax = _MComp_TableMax($aTable) / (2 ^ $iBitrate - 1), $iTmp, $iAnz
For $i = 0 To UBound($aTable) - 1 Step 1
$iTmp = $aTable[$i][1] / $iMax
$aTable[$i][1] = ($iTmp < 1) ? 1 : Round($iTmp)
$iAnz += $aTable[$i][1]
Next
Local $aRet = $aTable
_MComp_TableDivide($aTable, $iAnz)
Return $aRet
EndFunc ;==>_MComp_TableCompress
; |------------------------------------------------------------------------------|
; | Return: Aus Table und Intervall berechnetes neues Intervall
; | ByRef : Übergebener 2D-Table wird um eine Position nach oben rotiert
; | Opt : Bei Bedarf lässt sich die Table-Rotation ausschalten
; |------------------------------------------------------------------------------|
Func _MComp_IntervalCalcNew($aInt, ByRef $aTable, $bRotate = True)
Local $iSize = $aInt[1] - $aInt[0], $iUBound = UBound($aTable)
Local $aIntNew[$iUBound][2], $iTmp = $aInt[0]
For $i = 0 To $iUBound - 1 Step 1
$aIntNew[$i][0] = $aTable[$i][0]
$aIntNew[$i][1] = $iTmp + $aTable[$i][1] * $iSize
$iTmp += $aTable[$i][1] * $iSize
Next
If $bRotate Then _MComp_TableRotate($aTable)
Return $aIntNew
EndFunc ;==>_MComp_IntervalCalcNew
; |------------------------------------------------------------------------------|
; | Return: 2D-Wahrscheinlichkeitstabelle für jedes Zeichen im Text
; | Opt : Die Wahrscheinlichkeitsbitrate ist zwischen 1 und 16 frei wählbar
; |------------------------------------------------------------------------------|
Func _MComp_StringCreateTable($sText, $iBitrate = 0)
Local $aTable = _MComp_StringCountChars($sText)
_MComp_TableDivide($aTable, _MComp_TableSum($aTable))
If $iBitrate > 0 Then _MComp_TableCompress($aTable, $iBitrate)
Return $aTable
EndFunc ;==>_MComp_StringCreateTable
; |------------------------------------------------------------------------------|
; | ByRef : Übergebenes 1D-Array wird in ein 2D-Array übersetzt
; |------------------------------------------------------------------------------|
Func _MComp_ArrayMake2D(ByRef $aArray1D)
If Not UBound($aArray1D, 0) = 1 Then Return SetError(1)
Local $aArray2D[256][2], $iCnt = 0
For $i = 0 To 255 Step 1
If $aArray1D[$i] Then
$aArray2D[$iCnt][0] = $i
$aArray2D[$iCnt][1] = $aArray1D[$i]
$iCnt += 1
EndIf
Next
ReDim $aArray2D[$iCnt][2]
$aArray1D = $aArray2D
EndFunc ;==>_MComp_ArrayMake2D
; |------------------------------------------------------------------------------|
; | ByRef : Übergebenes 2D-Array wird um eine Position nach oben rotiert
; |------------------------------------------------------------------------------|
Func _MComp_TableRotate(ByRef $aArray)
If Not UBound($aArray, 0) = 2 Then Return SetError(1)
Local $iTmp[2] = [$aArray[0][0], $aArray[0][1]], $iUBound = UBound($aArray)
For $i = 0 To $iUBound - 2 Step 1
$aArray[$i][0] = $aArray[$i + 1][0]
$aArray[$i][1] = $aArray[$i + 1][1]
Next
$aArray[$iUBound - 1][0] = $iTmp[0]
$aArray[$iUBound - 1][1] = $iTmp[1]
EndFunc ;==>_MComp_TableRotate
; |------------------------------------------------------------------------------|
; | Return: Array[256] mit der zum Index gehörenden Anzahl Zeichenfunde
; |------------------------------------------------------------------------------|
Func _MComp_StringCountChars($sString)
Local $aRet[256], $sBin = _MComp_StringToHex($sString)
For $i = 1 To StringLen($sBin) Step 2
$aRet['0x' & StringMid($sBin, $i, 2)] += 1
Next
_MComp_ArrayMake2D($aRet)
Return $aRet
EndFunc ;==>_MComp_StringCountChars
; |------------------------------------------------------------------------------|
; | Return: Informationsgehalt eines Strings bei konstanter Bitrate/Zeichen
; | Opt : Die Genauigkeit in Dezimalstellen kann angepasst werden
; |------------------------------------------------------------------------------|
Func _MComp_StringGetInformationContent($sString, $iDec = 2)
Return Round(StringLen($sString) * Log(UBound( _
_MComp_StringCreateTable($sString))) / Log(2) / 8, $iDec)
EndFunc ;==>_MComp_StringGetInformationContent
; |------------------------------------------------------------------------------|
; | Return: Hexadezimalrepräsentation eines ASC256-Strings ohne führendes '0x'
; |------------------------------------------------------------------------------|
Func _MComp_StringToHex($sString)
Return StringTrimLeft(StringToBinary($sString), 2)
EndFunc ;==>_MComp_StringToHex
; |------------------------------------------------------------------------------|
; | Return: ASC265-String einer Hexadezimalrepräsentation ohne führendes '0x'
; |------------------------------------------------------------------------------|
Func _MComp_HexToString($sHex)
Return BinaryToString('0x' & $sHex)
EndFunc ;==>_MComp_HexToString
; |------------------------------------------------------------------------------|
; | Return: Summe aller Wahrscheinlichkeiten eines Tables
; |------------------------------------------------------------------------------|
Func _MComp_TableSum($aArray)
If Not UBound($aArray, 0) = 1 Then Return SetError(1)
Local $iCnt = $aArray[0][1]
For $i = 1 To UBound($aArray) - 1 Step 1
$iCnt += $aArray[$i][1]
Next
Return $iCnt
EndFunc ;==>_MComp_TableSum
; |------------------------------------------------------------------------------|
; | Return: Maximalwert der Wahrscheinlichkeiten eines Tables
; |------------------------------------------------------------------------------|
Func _MComp_TableMax($aArray)
Local $iMax = $aArray[0][1]
For $i = 1 To UBound($aArray) - 1 Step 1
If $aArray[$i][1] > $iMax Then $iMax = $aArray[$i][1]
Next
Return $iMax
EndFunc ;==>_MComp_TableMax
; |------------------------------------------------------------------------------|
; | ByRef : Die Wahrscheinlichkeitswerte des Tables werden durch iNum dividiert
; |------------------------------------------------------------------------------|
Func _MComp_TableDivide(ByRef $aArray, $iNum)
For $i = 0 To UBound($aArray) - 1 Step 1
$aArray[$i][1] /= $iNum
Next
EndFunc ;==>_MComp_TableDivide
Archiviert: 23.05.2014
Hab die Kodierung mit einigen Suboptimalitäten zum laufen bekommen.
Es wird nun aus einem beliebigen String ein codierter Hexstring erzeugt der (im Idealfall) weniger Bytes beansprucht als der ursprüngliche String.
ToDo:
DecToBin, BinToDec, DecToHex, HexToDec - Suboptimal
Table Einbindung IMMER mit 8Bit Kompression - wird später variabel und effizienter sein
Das Tempo könnte auch noch steigen. Wäre jedenfalls nicht schlecht 
Skript
#include <Array.au3>
Global $a_[256], $b_[256], $c_[11111112]
[/autoit] [autoit][/autoit] [autoit]_DecToBin_Startup()
[/autoit] [autoit][/autoit] [autoit]Global $sText = _
'Hallo, ich will komprimiert werden. Das gefällt ' & _
'mir sehr gut. Sehr Schön, Ciao ! Sowas könnte ic' & _
'h den ganzen lieben langen Tag machen. Da wird j' & _
'a der Hund in der Pfanne Verrückt. Sowas lasse i' & _
'ch nicht einfach durchgehen, ihr Banausen ! Da g' & _
'eht mir die Hutschnur wenn ich sowas sehe, das i' & _
'st ja nicht zum Aushalten ! Bei sowas könnte ich' & _
' mich grad vergessen. Das geht überhaupt nicht ! '
Global $sComp = _MComp_StringEncode($sText, 
ConsoleWrite('Comp: ( ' & StringLen($sComp)/2 & ' Bytes ) ' & $sComp & @CRLF)
Global $sDec = _MComp_StringDecode($sComp)
[/autoit] [autoit][/autoit] [autoit]ConsoleWrite('Dec: ( ' & StringLen($sDec) & ' Bytes ) ' & $sDec & @CRLF)
If Not ($sDec == $sText) Then ConsoleWrite('! ERROR: Data corrupted !' & @CRLF & @CRLF)
; Nicht Optimal !
Func _MComp_DecToHex($sDec)
Local $sBin = __MComp_DecToBin($sDec), $iLen = Hex(Int(StringLen($sBin)),4), $sHex
While Not IsInt(StringLen($sBin)/8)
$sBin &= 0
WEnd
For $i = 1 To StringLen($sBin) Step 8
;~ ConsoleWrite(StringMid($sBin, $i, & ' - ' & Hex(Int(_BinToDec(StringMid($sBin, $i, 8))),2) & @CRLF)
$sHex &= Hex(Int(_BinToDec(StringMid($sBin, $i, 8))),2)
Next
;~ ConsoleWrite('ssssssssssssssssssssssssssssssssssssssssss' & @CRLF)
Return $iLen & $sHex
EndFunc
; Nicht Optimal !
Func _MComp_HexToDec($sHex)
Local $iLen = Int('0x' & StringLeft($sHex, 4)), $sBin
$sHex = StringTrimLeft($sHex, 4)
For $i = 1 To StringLen($sHex) Step 2
;~ ConsoleWrite(StringRight('00000000' & _DecToBin(StringMid($sHex, $i, 2)), & ' - ' & StringMid($sHex, $i, 2) & @CRLF)
$sBin &= StringRight('00000000' & _DecToBin(Int('0x' & StringMid($sHex, $i, 2))),
Next
;~ Return $sBin
Return __MComp_BinToDec(StringLeft($sBin, $iLen))
EndFunc
Func _MComp_TableToString($aTable, $nBit = 0)
$nBit = 8 ;wird noch geändert !
; Aufbau:
; StartBit | ZielBit | Bit |Inhalt
; 1 | 4 | 4 | Rundungsstärke in Bit (1 -> 15)
; 5 | 12 | 8 | Anzahl Zeichen (1 -> 256)
; 13 | 15 | 4 | Charset (1 -> 15) ( bisher nur bis 7 befüllt )
; 16 | 23 | 8 | Hinzuzufügende Zeichen
; 24 | 31 | 8 | Abzuziehende Zeichen
; 32 | x | ... | Abzuziehende Zeichen je 8 Bit
; x+1 | y | ... | Hinzugefügte Zeichen je 8 Bit, Hinzugefügte Wahrscheinlichkeiten je x Bit
; Bsp: 39 Zeichen | Bitrate: 6 | Charset: Leer
; Header: 4+8+4+8+8 = 32Bit
; Abzüge: 0 = 0 Bit
; Zusätz: 39*8+39*6 = 546 Bit
; compData = 1695 Bit
; -> 284.125 Byte
; -> Kompression in Bezug auf 8 Bit/Char -> 74%
; Bisher:
; Anzahl|Char|Wert .... -> Char|Wert
If $nBit Then $aTable = _MComp_TableCompress($aTable, $nBit)
Local $iAnz
Local $sRet
For $i = 0 To 255 Step 1
If $aTable[$i] Then
$sRet &= Hex($i, 2) & Hex(Int($aTable[$i]), 2)
$iAnz += 1
EndIf
Next
Return Hex(Int($iAnz), 2) & $sRet
EndFunc
Func _MComp_StringToTable($sComp)
Local $nBit = 8 ; wird noch geändert !
Local $iLen = Int('0x' & StringLeft($sComp, 4))
$sComp = StringTrimLeft($sComp, 4)
Local $iAnz = Int('0x' & StringLeft($sComp, 2)), $iCnt
Local $aTable[256], $aRet[3] = [$iLen, 0, 0]
For $i = 3 To 3 + ($iAnz - 1) * 4 Step 4
$aTable['0x' & StringMid($sComp, $i, 2)] = '0x' & StringMid($sComp, $i+2, 2)
Next
For $i = 0 To 255 Step 1
$iCnt += $aTable[$i]
Next
For $i = 0 To 255 Step 1
$aTable[$i] /= $iCnt
Next
$aRet[1] = $aTable
$aRet[2] = StringTrimLeft($sComp, 2 + $iAnz * 4)
Return $aRet
EndFunc
Func _MComp_StringDecode($sComp)
Local $aDec = _MComp_StringToTable($sComp), $aTable = $aDec[1], _
$iLen = $aDec[0], $aInterval = [0, 1], $aIntNew, $sRet, $iTMP
$sComp = _MComp_HexToDec($aDec[2])
While $iLen
$iTMP = Number('0.' & StringLeft($sComp, 20))
$aIntNew = _MComp_IntervalCreate($aInterval, $aTable)
For $i = 0 To UBound($aIntNew) - 1 Step 1
If $iTMP < $aIntNew[$i][1] Then ExitLoop
Next
$sRet &= Chr($aIntNew[$i][0])
$iLen -= 1
$aInterval[1] = $aIntNew[$i][1]
If $i <> 0 Then $aInterval[0] = $aIntNew[$i-1][1]
While StringLeft($sComp, 1) = StringLeft($aInterval[0] * 10, 1) And StringLeft($sComp, 1) = StringLeft($aInterval[1] * 10, 1)
$iTMP = StringLeft($sComp, 1)
$sComp = StringTrimLeft($sComp, 1)
$aInterval[0] = $aInterval[0] * 10 - $iTMP
$aInterval[1] = $aInterval[1] * 10 - $iTMP
WEnd
WEnd
Return $sRet
EndFunc
Func _MComp_StringEncode($sText, $nBit = 0)
Local $aTable = _MComp_StringCreateTable($sText, $nBit), $sTable _
= _MComp_TableToString($aTable, $nBit), $aInterval = [0, 1], _
$sBin = StringTrimLeft(StringToBinary($sText),2), $sRet, $sChar _
, $aIntNew, $iTMP, $aTableBit = _MComp_TableCompress($aTable, $nBit)
For $i = 1 To StringLen($sBin) Step 2
$sChar = Int('0x' & StringMid($sBin, $i, 2))
$aIntNew = _MComp_IntervalCreate($aInterval, $aTable)
For $e = 0 To UBound($aIntNew) - 1 Step 1
If $aIntNew[$e][0] = $sChar Then ExitLoop
Next
$aInterval[1] = $aIntNew[$e][1]
If $e <> 0 Then $aInterval[0] = $aIntNew[$e-1][1]
While StringLeft($aInterval[0] * 10, 1) = StringLeft($aInterval[1] * 10, 1)
$iTMP = StringLeft($aInterval[0] * 10, 1)
$sRet &= $iTMP
$aInterval[0] = $aInterval[0] * 10 - $iTMP
$aInterval[1] = $aInterval[1] * 10 - $iTMP
WEnd
Next
Return Hex(Int(StringLen($sText)),4) & $sTable & '' & _MComp_DecToHex($sRet & Round(($aInterval[0] + $aInterval[1]) * 5, 0))
EndFunc
; Komprimiert den Table mit einer Bitrate. Rückgabe ist
; der Table mit Werten zwischen 0 und 2^n-1. Der Table
; selbst wird noch durch die Summe aller Werte geteilt,
; damit er wieder eine Wahrscheinlichkeitstabelle ist.
Func _MComp_TableCompress(ByRef $aTable, $nBit)
If Not $nBit Then Return $aTable
Local $iMax = $aTable[0], $iTMP, $iAnz
For $i = 1 To UBound($aTable) - 1 Step 1
If $aTable[$i] > $iMax Then $iMax = $aTable[$i]
Next
For $i = 1 To UBound($aTable) - 1 Step 1
If $aTable[$i] Then
$iTMP = $aTable[$i]/$iMax*(2^$nBit-1)
If $iTMP < 0.5 Then
$aTable[$i] = 1
Else
$aTable[$i] = Round($iTMP)
EndIf
$iAnz += $aTable[$i]
EndIf
Next
Local $aRet = $aTable
For $i = 1 To UBound($aTable) - 1 Step 1
$aTable[$i] /= $iAnz
Next
Return $aRet
EndFunc
Func _MComp_IntervalCreate($aInterval, $aTable)
Local $nSize = $aInterval[1] - $aInterval[0], $iAnz
For $i = 0 To 255 Step 1
If $aTable[$i] Then
$aTable[$i] *= $nSize
$iAnz += 1
EndIf
Next
Local $aIntNew[$iAnz][2], $iTMP = $aInterval[0]
$iAnz = 0
For $i = 0 To 255 Step 1
If $aTable[$i] Then
$aIntNew[$iAnz][0] = $i
$aIntNew[$iAnz][1] = $iTMP + $aTable[$i]
$iTMP += $aTable[$i]
$iAnz += 1
EndIf
Next
Return $aIntNew
EndFunc
; nicht Optimal !
; Ersetzen von ddd -> 10 Bit (Verlust: 0.34%)
; Am Ende ggf bis zu 7 Bit Verlust !
Func __MComp_DecToBin($sDec)
While Not IsInt(StringLen($sDec)/3)
$sDec &= 0
WEnd
Local $sRet
For $i = 1 To StringLen($sDec) Step 3
$sRet &= StringRight('0000000000' & _DecToBin(StringMid($sDec, $i, 3)), 10)
Next
Return $sRet
EndFunc
Func __MComp_BinToDec($sBin)
Local $sRet
For $i = 1 To StringLen($sBin) Step 10
$sRet &= StringRight('000' & _BinToDec(StringMid($sBin, $i, 10)), 3)
Next
Return $sRet
EndFunc
; Erzeugt eine Wahrscheinlichkeitstabelle zu jedem Zeichen
; in einem String. Rückgabe ist ein Array[256] mit den
; Wahrscheinlichkeiten zu jedem Index.
Func _MComp_StringCreateTable($sText, $nBit = 0)
Local $aCount = _MComp_StringCount($sText), $iTMP
For $i = 0 To 255 Step 1
$iTMP += $aCount[$i]
Next
For $i = 0 To 255 Step 1
$aCount[$i] /= $iTMP
Next
If $nBit Then _MComp_TableCompress($aCount, $nBit)
Return $aCount
EndFunc
; Zählt die Vorkommnisse der einzelnen 256 Zeichen in einem
; String und gibt diese als Array[256] zurück,
Func _MComp_StringCount($sText)
Local $aRet[256], $sBin = StringTrimLeft(StringToBinary($sText), 2)
For $i = 1 To StringLen($sBin) Step 2
$aRet['0x' & StringMid($sBin, $i, 2)] += 1
Next
Return $aRet
EndFunc
; <Func>--------------------------------------------------|
; Wandelt eine Dualzahl in eine Dezimalzahl um |
; --------------------------------------------------------|
Func _BinToDec($s)
Local $l = StringLen($s)
Return $l<9?$c_[$s]:$l<17?$c_[StringTrimRight($s,8)]*256+$c_[StringRight($s,8)]:$l<25?$c_[StringTrimRight($s,16)]*65536+$c_[StringRight(StringTrimRight($s,8),8)]*256+ $c_[StringRight($s,8)]:BitShift($c_[StringTrimRight($s,24)],-24)+$c_[StringRight(StringTrimRight($s,16),8)]*65536+$c_[StringRight(StringTrimRight($s,8),8)]*256+$c_[StringRight($s,8)]
EndFunc
; <Func>--------------------------------------------------|
; Ermittelt eine Dualzahl (0101) aus einer Dezimalzahl |
; Die Dezimalzahl muss kleiner als 2^31 sein |
; --------------------------------------------------------|
Func _DecToBin($d)
Return $d<256?$a_[$d]:$d<65536?$a_[$d/256]&$b_[BitAND($d,255)]:$d<16777216?$a_[$d/65536]&$b_[BitAND($d/256,255)]&$b_[BitAND($d,255)]:$a_[BitShift($d,24)]&$b_[BitAND($d/65536,255)]&$b_[BitAND($d/256,255)]&$b_[BitAND($d,255)]
EndFunc
; <Func>--------------------------------------------------|
; Initialisiert die DecToBin UDF |
; --------------------------------------------------------|
Func _DecToBin_Startup()
Local $t = DllStructCreate('char[64]'), $p = _
DllStructGetPtr($t), $hDll = DllOpen('msvcrt.dll')
For $i = 0 To 255 Step 1
DllCall($hDll, 'ptr:cdecl', '_i64toa', 'int64', _
$i, 'ptr', $p, 'int', 2)
$a_[$i] = DllStructGetData($t, 1)
$b_[$i] = StringRight('0000000' & $a_[$i],
$c_[$a_[$i]] = $i
Next
DllClose($hDll)
EndFunc
Alter Inhalt
Moin,
Da mir die Huffman Codierung bei einigen Tests nicht sonderlich gefallen hat, habe ich mich mal an der Arithmetischen Codierung versucht. Wie die Funktioniert steht auf Wikipedia: Hier
In der jetzigen Ausführung wird beim Komprimieren ausschließlich die Zahl ausgegeben. Zum Dekomprimieren benötigt man weiterhin die Wahrscheinlichkeitstabelle, sowie die Stringlänge. Bevor ich mich dem widme möchte ich wissen, ob das Konzept überhaupt anständig funktioniert.
Das Problem ist in dem Fall die Kommagenauigkeit. Diese wird zwar regelmäßig hochgesetzt, aber trotzdem habe ich einige Rundungsfehler bemerkt (die seltsamerweise keine Auswirkung auf das Ergebnis haben).
"Skript läuft mit der aktuellen Stable"
#include <Array.au3>
Global $sText = _
'Hallo, ich will komprimiert werden. Das gefällt ' & _
'mir sehr gut. Sehr Schön, Ciao ! Sowas könnte ic' & _
'h den ganzen lieben langen Tag machen. Da wird j' & _
'a der Hund in der Pfanne Verrückt. Sowas lasse i' & _
'ch nicht einfach durchgehen, ihr Banausen ! Da g' & _
'eht mir die Hutschnur wenn ich sowas sehe, das i' & _
'st ja nicht zum Aushalten ! Bei sowas könnte ich' & _
' mich grad vergessen. Das geht überhaupt nicht !'
Local $x = [0, 1], $iAnz = UBound(_MComp_IntervalCreate($x, _MComp_StringCreateTable($sText)))
[/autoit] [autoit][/autoit] [autoit]ConsoleWrite('String -> (' & $iAnz & ')' & @CRLF & '> ' & $sText & @CRLF & 'Len: ' & StringLen($sText) & @CRLF & 'Größe: ' & Round(StringLen($sText)*Log($iAnz)/Log(2)/8) & ' Byte' & @CRLF & @CRLF)
[/autoit] [autoit][/autoit] [autoit]Global $sComp = _MComp_StringEncode($sText)
[/autoit] [autoit][/autoit] [autoit]$x[0] = 0
$x[1] = 1
$iAnz = UBound(_MComp_IntervalCreate($x, _MComp_StringCreateTable($sComp)))
ConsoleWrite('Coding -> (' & $iAnz & ')' & @CRLF & '> ' & $sComp & @CRLF & 'Len: ' & StringLen($sComp) & @CRLF & 'Größe: ' & Round(StringLen($sComp)*Log($iAnz)/Log(2)/8) & ' Byte' & @CRLF & @CRLF)
[/autoit] [autoit][/autoit] [autoit]Global $sDec = _MComp_StringDecode($sComp, _MComp_StringCreateTable($sText), StringLen($sText))
[/autoit] [autoit][/autoit] [autoit]ConsoleWrite('Decode ->' & @CRLF & '> ' & $sDec & @CRLF & @CRLF)
If Not $sDec == $sText Then ConsoleWrite('! ERROR: Data corrupted !' & @CRLF)
Func _MComp_StringDecode($sComp, $aTable, $iLen)
Local $aInterval = [0, 1], $aIntNew, $sRet, $iTMP
While $iLen
$iTMP = Number('0.' & StringLeft($sComp, 20))
$aIntNew = _MComp_IntervalCreate($aInterval, $aTable)
For $i = 0 To UBound($aIntNew) - 1 Step 1
;~ ConsoleWrite('TMP: ' & $iTMP & ' - ' & 'nr: ' & $aIntNew[$i][1] & @CRLF)
If $iTMP < $aIntNew[$i][1] Then ExitLoop
Next
;~ ConsoleWrite('[' & $aInterval[0] & ' - ' & $aInterval[1] & ']' & @CRLF)
$sRet &= Chr($aIntNew[$i][0])
$iLen -= 1
;~ ConsoleWrite(BinaryToString('0x' & $aIntNew[$i][0]) & @CRLF)
$aInterval[1] = $aIntNew[$i][1]
If $i <> 0 Then $aInterval[0] = $aIntNew[$i-1][1]
;~ _ArrayDisplay($aInterval, $iTMP)
While StringLeft($sComp, 1) = StringLeft($aInterval[0] * 10, 1) And StringLeft($sComp, 1) = StringLeft($aInterval[1] * 10, 1)
$iTMP = StringLeft($sComp, 1)
$sComp = StringTrimLeft($sComp, 1)
$aInterval[0] = $aInterval[0] * 10 - $iTMP
$aInterval[1] = $aInterval[1] * 10 - $iTMP
WEnd
WEnd
Return $sRet
EndFunc
Func _MComp_StringEncode($sText)
Local $aTable = _MComp_StringCreateTable($sText), _
$aInterval = [0, 1], $sBin = StringTrimLeft( _
StringToBinary($sText),2), $sRet, $sChar, $aIntNew, $iTMP
For $i = 1 To StringLen($sBin) Step 2
$sChar = Int('0x' & StringMid($sBin, $i, 2))
$aIntNew = _MComp_IntervalCreate($aInterval, $aTable)
For $e = 0 To UBound($aIntNew) - 1 Step 1
If $aIntNew[$e][0] = $sChar Then ExitLoop
Next
$aInterval[1] = $aIntNew[$e][1]
If $e <> 0 Then $aInterval[0] = $aIntNew[$e-1][1]
While StringLeft($aInterval[0] * 10, 1) = StringLeft($aInterval[1] * 10, 1)
$iTMP = StringLeft($aInterval[0] * 10, 1)
$sRet &= $iTMP
$aInterval[0] = $aInterval[0] * 10 - $iTMP
$aInterval[1] = $aInterval[1] * 10 - $iTMP
WEnd
Next
Return $sRet & Round(($aInterval[0] + $aInterval[1]) * 5, 0)
EndFunc
Func _MComp_IntervalCreate($aInterval, $aTable)
Local $nSize = $aInterval[1] - $aInterval[0], $iAnz
For $i = 0 To 255 Step 1
If $aTable[$i] Then
$aTable[$i] *= $nSize
$iAnz += 1
EndIf
Next
Local $aIntNew[$iAnz][2], $iTMP = $aInterval[0]
$iAnz = 0
For $i = 0 To 255 Step 1
If $aTable[$i] Then
$aIntNew[$iAnz][0] = $i
$aIntNew[$iAnz][1] = $iTMP + $aTable[$i]
$iTMP += $aTable[$i]
$iAnz += 1
EndIf
Next
Return $aIntNew
EndFunc
Func _MComp_StringCreateTable($sText)
Local $aCount = _MComp_StringCount($sText), $iTMP
For $i = 0 To 255 Step 1
$iTMP += $aCount[$i]
Next
For $i = 0 To 255 Step 1
$aCount[$i] /= $iTMP
Next
Return $aCount
EndFunc
Func _MComp_StringCount($sText)
Local $aRet[256], $sBin = StringTrimLeft(StringToBinary($sText), 2)
For $i = 1 To StringLen($sBin) Step 2
$aRet['0x' & StringMid($sBin, $i, 2)] += 1
Next
Return $aRet
EndFunc
Zum Testen und Benutzen für alle die Lustig sind
lg Mars