jvanegmond Posted October 6, 2008 Share Posted October 6, 2008 (edited) I'm adding a Burrows Wheeler transform later.Run this in SciTE or you will not be able to read the console:expandcollapse popupDim $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 October 6, 2008 by Manadar github.com/jvanegmond Link to comment Share on other sites More sharing options...
trancexx Posted October 6, 2008 Share Posted October 6, 2008 Nice. I'm fascinated by the simplicity of, for example, LZW algorithm and its ability to exploit many patterns. ♡♡♡ . eMyvnE Link to comment Share on other sites More sharing options...
spudw2k Posted October 6, 2008 Share Posted October 6, 2008 (edited) Here's my go at the Burrows-Wheeler algo. expandcollapse popup#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 February 26, 2015 by spudw2k Spoiler Things I've Made: Always On Top Tool ◊ AU History ◊ Deck of Cards ◊ HideIt ◊ ICU ◊ Icon Freezer ◊ Ipod Ejector ◊ Junos Configuration Explorer ◊ Link Downloader ◊ MD5 Folder Enumerator ◊ PassGen ◊ Ping Tool ◊ Quick NIC ◊ Read OCR ◊ RemoteIT ◊ SchTasksGui ◊ SpyCam ◊ System Scan Report Tool ◊ System UpTime ◊ Transparency Machine ◊ VMWare ESX BuilderMisc Code Snippets: ADODB Example ◊ CheckHover ◊ Detect SafeMode ◊ DynEnumArray ◊ GetNetStatData ◊ HashArray ◊ IsBetweenDates ◊ Local Admins ◊ Make Choice ◊ Recursive File List ◊ Remove Sizebox Style ◊ Retrieve PNPDeviceID ◊ Retreive SysListView32 Contents ◊ Set IE Homepage ◊ Tickle Expired Password ◊ Transpose ArrayProjects: Drive Space Usage GUI ◊ LEDkIT ◊ Plasma_kIt ◊ Scan Engine Builder ◊ SpeeDBurner ◊ SubnetCalcCool Stuff: AutoItObject UDF ◊ Extract Icon From Proc ◊ GuiCtrlFontRotate ◊ Hex Edit Funcs ◊ Run binary ◊ Service_UDF Link to comment Share on other sites More sharing options...
Fossil Rock Posted October 6, 2008 Share Posted October 6, 2008 To trancexx... I dare ya. Agreement is not necessary - thinking for one's self is! Link to comment Share on other sites More sharing options...
Recommended Posts
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 accountSign in
Already have an account? Sign in here.
Sign In Now