Sign in to follow this  
Followers 0
jvanegmond

Basic lossless string encoding example

4 posts in this topic

#1 ·  Posted (edited)

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



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

#3 ·  Posted (edited)

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

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  
Followers 0