Jump to content
Sign in to follow this  
jvanegmond

Basic lossless string encoding example

Recommended Posts

jvanegmond

I'm adding a Burrows Wheeler transform later.

Run this in SciTE or you will not be able to read the console:

Dim $In = "BWAABBBWAABWWWAABWAAAAAABWAABWAABWAA"
Dim $Out = ""

Dim $Char = StringSplit($In,"")
Dim $Buffer = "", $i = 1
Dim $Result[1]

While $i <= $Char[0]
    $Buffer &= $Char[$i]
    
    If ($i+1 <= $Char[0]) AND (Not ($Char[$i] == $Char[$i+1])) Then
        _Add($Buffer)
        $Buffer = ""
    EndIf
    
    $i += 1
WEnd
_Add($Buffer)

For $i = 1 to UBound($Result)-1
    ;If (StringLen($Result[$i]) == 1) Then
    ;   $Out &= $Result[$i]
    ;Else
        $Out &= StringLen($Result[$i]) & StringLeft($Result[$i],1)
    ;EndIf
Next

ConsoleWrite("String length before: " & StringLen($In) & @CRLF)
ConsoleWrite("String length after: " & StringLen($Out) & @CRLF)
ConsoleWrite("KB saved: " & ((StringLen($In)-StringLen($Out))/1024) & " ( " & (StringLen($In)-StringLen($Out)) & " bytes or " & Round((StringLen($In)-StringLen($Out))/StringLen($In)*100,1) &  "% )" & @CRLF)
ConsoleWrite("In : " & StringLeft($In,100) & @CRLF)
ConsoleWrite("Out: " & StringLeft($Out,100) & @CRLF)

Func _Add($String)
    $n = UBound($Result)
    Redim $Result[$n+1]
    $Result[$n] = $String
EndFunc
Edited by Manadar

Share this post


Link to post
Share on other sites
trancexx

Nice.

I'm fascinated by the simplicity of, for example, LZW algorithm and its ability to exploit many patterns.


♡♡♡

.

eMyvnE

Share this post


Link to post
Share on other sites
spudw2k

Here's my go at the Burrows-Wheeler algo. :P

#include <Array.au3>
 
Local $sText = "SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES"
$timer = TimerInit()
Local $sBWT = _BWT($sText)
ConsoleWrite(TimerDiff($timer) & @CRLF)
$timer = TimerInit()
Local $sBWTInverse = _BWTInverse($sBWT)
ConsoleWrite(TimerDiff($timer) & @CRLF)
$timer = 0
 
Msgbox(0,"_BWT",$sText & @CRLF & $sBWT)
Msgbox(0,"_BWTInverse",$sBWT & @CRLF & $sBWTInverse)
 
Func _BWT($sInput)
   If Not IsString($sInput) Then Return SetError(1,0,False)
   Local $sTransform = $sInput & Chr(3)
   Local $aRotationsTable[StringLen($sTransform)]
   Local $iSubscripts = UBound($aRotationsTable)
   For $i = 0 To $iSubscripts - 1
   $aRotationsTable[$i] = $sTransform
   $sTransform = StringTrimLeft($sTransform,1) & StringLeft($sTransform,1)
   Next
   $aRotationsTable = __BWTTableSort($aRotationsTable)
   $sTransform = ""
   For $i = 0 to $iSubscripts - 1
   $sTransform &= StringRight($aRotationsTable[$i],1)
   Next
   Return $sTransform
EndFunc
 
Func _BWTInverse($sInput)
   If Not IsString($sInput) Then Return SetError(1,0,False)
   If Not StringInstr($sInput, Chr(3)) Then Return SetError(2,0,False)
   Local $aSortTable[StringLen($sInput)]
   Local $iSubscripts = UBound($aSortTable)
   Local $aAddTable[$iSubscripts]
   For $i = 0 to $iSubscripts - 1
   For $j = 0 To $iSubscripts - 1
   $aAddTable[$j] = StringMid($sInput, $j + 1, 1) & $aSortTable[$j]
   Next
   If $i < $iSubscripts - 1 Then $aSortTable = __BWTInverseSort($aAddTable)
   Next
   For $i = 0 to $iSubscripts - 1
   If StringLeft($aAddTable[$i],1) = Chr(3) Then Return StringTrimLeft($aAddTable[$i],1)
   Next
EndFunc
 
Func __BWTInverseSort($aTable)
   Local $iSubscripts = UBound($aTable)
   Local $iEOFRow = 0
   Local $sEOFRowString = ""
   _ArraySort($aTable)
   For $i = 0 To $iSubscripts - 1
   If StringLeft($aTable[$i], 1) = Chr(3) Then
   $iEOFRow = $i
   $sEOFRowString = $aTable[$i]
   $i = $iSubscripts - 1
   EndIf
   Next
   _ArrayDelete($aTable, $iEOFRow)
   _ArrayAdd($aTable, $sEOFRowString)
   Return $aTable
EndFunc
 
Func __BWTTableSort($aTable)
   Local $iSubscripts = UBound($aTable) - 1
   Local $aBWTTable[$iSubscripts]
   For $i = 0 To $iSubscripts - 1
   $aBWTTable[$i] = $aTable[$i]
   Next
   _ArraySort($aBWTTable)
   Redim $aBWTTable[$iSubscripts + 1]
   $aBWTTable[$iSubscripts] = $aTable[$iSubscripts]
   Return $aBWTTable
EndFunc

working on inverse.

edit: Had another go at this...with inverse.  It has issues with special chars...still a fun exercise.

Edited by spudw2k

Share this post


Link to post
Share on other sites
Fossil Rock

To trancexx... I dare ya.


Agreement is not necessary - thinking for one's self is!

My-Colors.jpg

cuniform2.gif

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Sign in to follow this  

×

Important Information

We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.