RosettaCodeData/Task/LZW-compression/REALbasic/lzw-compression.realbasic

106 lines
2.4 KiB
Plaintext

Function compress(str as String) As String
Dim i as integer
Dim w as String = ""
Dim c as String
Dim strLen as Integer
Dim wc as string
Dim dic() as string
Dim result() as string
Dim lookup as integer
Dim startPos as integer = 0
Dim combined as String
strLen = len(str)
dic = populateDictionary
for i = 1 to strLen
c = str.mid(i, 1)
wc = w + c
startPos = getStartPos(wc)
lookup = findArrayPos(dic, wc, startPos)
if (lookup <> -1) then
w = wc
Else
startPos = getStartPos(w)
lookup = findArrayPos(dic, w, startPos)
if lookup <> -1 then
result.Append(lookup.ToText)
end if
dic.append(wc)
w = c
end if
next i
if (w <> "") then
startPos = getStartPos(w)
lookup = findArrayPos(dic, w, startPos)
result.Append(lookup.ToText)
end if
return join(result, ",")
End Function
Function decompress(str as string) As string
dim comStr() as string
dim w as string
dim result as string
dim comStrLen as integer
dim entry as string
dim dic() as string
dim i as integer
comStr = str.Split(",")
comStrLen = comStr.Ubound
dic = populateDictionary
w = chr(val(comStr(0)))
result = w
for i = 1 to comStrLen
entry = dic(val(comStr(i)))
result = result + entry
dic.append(w + entry.mid(1,1))
w = entry
next i
return result
End Function
Private Function findArrayPos(arr() as String, search as String, start as integer) As Integer
dim arraySize as Integer
dim arrayPosition as Integer = -1
dim i as Integer
arraySize = UBound(arr)
for i = start to arraySize
if (strcomp(arr(i), search, 0) = 0) then
arrayPosition = i
exit
end if
next i
return arrayPosition
End Function
Private Function getStartPos(str as String) As integer
if (len(str) = 1) then
return 0
else
return 255
end if
End Function
Private Function populateDictionary() As string()
dim dic() as string
dim i as integer
for i = 0 to 255
dic.append(Chr(i))
next i
return dic
End Function