September Morn Update
This commit is contained in:
Ingy döt Net
parent
4e2d22a71d
commit
aac6731f2c
6856 changed files with 141342 additions and 21127 deletions
|
|
@ -26,7 +26,7 @@ defmodule LZW do
|
|||
|
||||
defp decode([], _, _, _, l), do: Enum.reverse(l) |> to_string
|
||||
defp decode([h|t], old, free, d, l) do
|
||||
val = d[h]
|
||||
val = if h == free, do: old ++ [List.first(old)], else: d[h]
|
||||
add = [List.last(val) | old]
|
||||
d1 = Map.put(d, free, add)
|
||||
decode(t, val, free+1, d1, val++l)
|
||||
|
|
|
|||
110
Task/LZW-compression/FreeBASIC/lzw-compression.freebasic
Normal file
110
Task/LZW-compression/FreeBASIC/lzw-compression.freebasic
Normal file
|
|
@ -0,0 +1,110 @@
|
|||
' version 22-02-2019
|
||||
' compile with: fbc -s console
|
||||
|
||||
Type dict
|
||||
prefix As Integer
|
||||
B As String
|
||||
End Type
|
||||
|
||||
Sub init(dictionary() As dict, ByRef last As ULong)
|
||||
|
||||
For i As ULong = 0 To 255
|
||||
dictionary(i).prefix = -1
|
||||
dictionary(i).B = Chr(i)
|
||||
Next
|
||||
last = 255
|
||||
|
||||
End Sub
|
||||
|
||||
Function encode_LZW(dictionary() As dict, last_entry As ULong, input_str As String) As String
|
||||
|
||||
If Len(input_str) < 2 Then
|
||||
Print "input string is to short"
|
||||
Return ""
|
||||
End If
|
||||
|
||||
Dim As String word, output_str, char
|
||||
Dim As ULong i = 1, index, j, len_input = Len(input_str)
|
||||
|
||||
Do
|
||||
If i > len_input Then
|
||||
output_str = output_str + " " + Str(index)
|
||||
Return output_str ' no more chars to process. we are done
|
||||
End If
|
||||
char = Mid(Input_str, i, 1)
|
||||
i += 1
|
||||
For j = 0 To last_entry
|
||||
If dictionary(j).B = word + char Then
|
||||
word += char
|
||||
index = j
|
||||
Continue Do
|
||||
End If
|
||||
Next
|
||||
output_str = output_str + " " + Str(index)
|
||||
last_entry = last_entry +1
|
||||
dictionary(last_entry).B = word + char
|
||||
dictionary(last_entry).prefix = index
|
||||
word = char : index = Asc(char)
|
||||
Loop
|
||||
|
||||
End Function
|
||||
|
||||
Function decode_LZW(dictionary() As dict, last_entry As ULong, input_str As String) As String
|
||||
|
||||
Dim As String temp, word, output_str
|
||||
Dim As ULong i, i1 = 1, j, index
|
||||
input_str = Trim(input_str)
|
||||
Dim As ULong len_input = Len(input_str)
|
||||
input_str = input_str + " "
|
||||
|
||||
i = InStr(i1, input_str, " ")
|
||||
index = Val(Mid(Input_str, i1, i - i1))
|
||||
word = dictionary(index).B
|
||||
output_str = word
|
||||
i1 = i +1
|
||||
Do
|
||||
i = InStr(i1, input_str, " ")
|
||||
If i >= len_input Then
|
||||
index = Val(Mid(input_str, i1))
|
||||
output_str = output_str + dictionary(index).B
|
||||
Return output_str
|
||||
End If
|
||||
index = Val(Mid(Input_str, i1, i - i1))
|
||||
i1 = i +1
|
||||
If index <= last_entry Then
|
||||
temp = dictionary(index).B
|
||||
Else
|
||||
temp = word + Left(word, 1)
|
||||
End If
|
||||
output_str = output_str + temp
|
||||
last_entry = last_entry +1
|
||||
dictionary(last_entry).B = word + Left(temp, 1)
|
||||
word = temp
|
||||
Loop
|
||||
|
||||
End Function
|
||||
|
||||
' ------=< MAIN >=------
|
||||
|
||||
Dim As ULong last_entry, max_bit = 9
|
||||
Dim As ULong dict_max = 1 Shl max_bit -1
|
||||
Dim As String output_str, input_str = "TOBEORNOTTOBEORTOBEORNOT"
|
||||
Dim As dict dictionary()
|
||||
|
||||
Print " input str: ";input_str
|
||||
|
||||
ReDim dictionary(dict_max +1)
|
||||
init(dictionary(), last_entry)
|
||||
output_str = encode_LZW(dictionary(), last_entry, input_str)
|
||||
Print "encoded str: ";output_str
|
||||
|
||||
ReDim dictionary(dict_max +1)
|
||||
init(dictionary(), last_entry)
|
||||
output_str = decode_LZW(dictionary(), last_entry, output_str)
|
||||
Print "decoded str: "; output_str
|
||||
|
||||
' empty keyboard buffer
|
||||
While InKey <> "" : Wend
|
||||
Print : Print "hit any key to end program"
|
||||
Sleep
|
||||
End
|
||||
38
Task/LZW-compression/Haskell/lzw-compression.hs
Normal file
38
Task/LZW-compression/Haskell/lzw-compression.hs
Normal file
|
|
@ -0,0 +1,38 @@
|
|||
import Data.List (elemIndex, tails)
|
||||
import Data.Maybe (fromJust)
|
||||
|
||||
doLZW :: Eq a => [a] -> [a] -> [Int]
|
||||
doLZW _ [] = []
|
||||
doLZW as (x:xs) = lzw (return <$> as) [x] xs
|
||||
where
|
||||
lzw a w [] = [fromJust $ elemIndex w a]
|
||||
lzw a w (x:xs)
|
||||
| w_ `elem` a = lzw a w_ xs
|
||||
| otherwise = fromJust (elemIndex w a) : lzw (a ++ [w_]) [x] xs
|
||||
where
|
||||
w_ = w ++ [x]
|
||||
|
||||
undoLZW :: [a] -> [Int] -> [a]
|
||||
undoLZW _ [] = []
|
||||
undoLZW a cs =
|
||||
cs >>=
|
||||
(!!)
|
||||
(foldl
|
||||
((.) <$> (++) <*>
|
||||
(\x xs -> return (((++) <$> head <*> take 1 . last) ((x !!) <$> xs))))
|
||||
(return <$> a)
|
||||
(take2 cs))
|
||||
|
||||
take2 :: [a] -> [[a]]
|
||||
take2 xs = filter ((2 ==) . length) (take 2 <$> tails xs)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
print $ doLZW ['\0' .. '\255'] "TOBEORNOTTOBEORTOBEORNOT"
|
||||
print $
|
||||
undoLZW
|
||||
['\0' .. '\255']
|
||||
[84, 79, 66, 69, 79, 82, 78, 79, 84, 256, 258, 260, 265, 259, 261, 263]
|
||||
print $
|
||||
((==) <*> ((.) <$> undoLZW <*> doLZW) ['\NUL' .. '\255'])
|
||||
"TOBEORNOTTOBEORTOBEORNOT"
|
||||
|
|
@ -1,7 +1,7 @@
|
|||
function compressLZW(decompressed::String)
|
||||
dictsize = 256
|
||||
dict = Dict{String,Int}(string(Char(i)) => i for i in range(0, dictsize))
|
||||
result = Vector{Int}(0)
|
||||
dict = Dict{String,Int}(string(Char(i)) => i for i in 0:dictsize)
|
||||
result = Vector{Int}(undef, 0)
|
||||
w = ""
|
||||
for c in decompressed
|
||||
wc = string(w, c)
|
||||
|
|
@ -20,9 +20,9 @@ end
|
|||
|
||||
function decompressLZW(compressed::Vector{Int})
|
||||
dictsize = 256
|
||||
dict = Dict{Int,String}(i => string('\0' + i) for i in range(0, dictsize))
|
||||
dict = Dict{Int,String}(i => string('\0' + i) for i in 0:dictsize)
|
||||
result = IOBuffer()
|
||||
w = string(Char(shift!(compressed)))
|
||||
w = string(Char(popfirst!(compressed)))
|
||||
write(result, w)
|
||||
for k in compressed
|
||||
if haskey(dict, k)
|
||||
|
|
@ -37,7 +37,7 @@ function decompressLZW(compressed::Vector{Int})
|
|||
dictsize += 1
|
||||
w = entry
|
||||
end
|
||||
return String(result)
|
||||
return String(take!(result))
|
||||
end
|
||||
|
||||
original = ["0123456789", "TOBEORNOTTOBEORTOBEORNOT", "dudidudidudida"]
|
||||
|
|
@ -46,5 +46,5 @@ decompressed = decompressLZW.(compressed)
|
|||
|
||||
for (word, comp, decomp) in zip(original, compressed, decompressed)
|
||||
comprate = (length(word) - length(comp)) / length(word) * 100
|
||||
println("Original: $word\n-> Compressed: $comp (compr.rate: $(round(comprate, 2))%)\n-> Decompressed: $decomp")
|
||||
println("Original: $word\n-> Compressed: $comp (compr.rate: $(round(comprate, digits=2))%)\n-> Decompressed: $decomp")
|
||||
end
|
||||
|
|
|
|||
25
Task/LZW-compression/Ol/lzw-compression-1.ol
Normal file
25
Task/LZW-compression/Ol/lzw-compression-1.ol
Normal file
|
|
@ -0,0 +1,25 @@
|
|||
(define (compress str)
|
||||
(let loop ((dc (fold (lambda (f x) ; dictionary (simplest, not optimized), with reversed codes
|
||||
(cons (list x) (cons x f)))
|
||||
'() (iota 256)))
|
||||
(w '()) ; output sequence (reversed)
|
||||
(s 256) ; maximal dictionary code value + 1
|
||||
(x '()) ; current sequence
|
||||
(r (str-iter str))); input stream
|
||||
(cond
|
||||
((null? r)
|
||||
(reverse (cons (cadr (member x dc)) w)))
|
||||
((pair? r)
|
||||
(let ((xy (cons (car r) x)))
|
||||
(if (member xy dc)
|
||||
(loop dc w s xy (cdr r))
|
||||
(loop (cons xy (cons s dc)) ; update dictionary with xy . s
|
||||
(cons (cadr (member x dc)) w) ; add code to output stream
|
||||
(+ s 1) ; increase code
|
||||
(list (car r)) ; new current sequence
|
||||
(cdr r))))) ; next input
|
||||
(else
|
||||
(loop dc w s x (r)))))
|
||||
)
|
||||
|
||||
(print (compress "TOBEORNOTTOBEORTOBEORNOT")) ; => (84 79 66 69 79 82 78 79 84 256 258 260 265 259 261 263)
|
||||
27
Task/LZW-compression/Ol/lzw-compression-2.ol
Normal file
27
Task/LZW-compression/Ol/lzw-compression-2.ol
Normal file
|
|
@ -0,0 +1,27 @@
|
|||
(define (decompress str)
|
||||
(let loop ((dc (fold (lambda (f x) ; dictionary (simplest, not optimized), with reversed codes
|
||||
(cons x (cons (list x) f)))
|
||||
'() (iota 256)))
|
||||
(w '()) ; output sequence (reversed)
|
||||
(s 256) ; maximal dictionary code value + 1
|
||||
(x '()) ; current symbols sequence
|
||||
(r (str-iter str))); input stream
|
||||
(cond
|
||||
((null? r)
|
||||
(reverse w))
|
||||
((pair? r)
|
||||
(let*((y (cadr (member (car r) dc)))
|
||||
(xy (append y x)))
|
||||
(if (member xy dc)
|
||||
(loop dc (append y w) s xy (cdr r)) ; вряд ли такое будет...
|
||||
(loop (cons s (cons xy dc)) ; update dictionary with xy . s
|
||||
(append y w) ; add phrase to output stream
|
||||
(+ s 1)
|
||||
y ; new initial code
|
||||
(cdr r))))) ; next input
|
||||
(else
|
||||
(loop dc w s x (r))))))
|
||||
|
||||
(print (runes->string
|
||||
(decompress (runes->string '(84 79 66 69 79 82 78 79 84 256 258 260 265 259 261 263)))))
|
||||
; => TOBEORNOTTOBEORTOBEEORNOT
|
||||
|
|
@ -38,7 +38,7 @@ Do i=1 To length(uncompressed)
|
|||
Else Do
|
||||
res=res||dict.w', '
|
||||
dict.wc=dict_size
|
||||
dict_size+=1
|
||||
dict_size=dict_size+1
|
||||
w=c
|
||||
End
|
||||
End
|
||||
|
|
@ -61,7 +61,7 @@ w=d.w
|
|||
Do i=1 To words(compressed)
|
||||
k=word(compressed,i)
|
||||
Select
|
||||
When d.k<>'' | d.k=='20'x then /* allow for blank */
|
||||
When d.k<>'' | d.k==' ' then /* allow for blank */
|
||||
entry=d.k
|
||||
When k=dict_size Then
|
||||
entry=w||substr(w,1,1)
|
||||
|
|
@ -70,7 +70,7 @@ Do i=1 To words(compressed)
|
|||
End
|
||||
res=res||entry
|
||||
d.dict_size=w||substr(entry,1,1)
|
||||
dict_size+=1
|
||||
dict_size=dict_size+1
|
||||
w=entry
|
||||
End
|
||||
Return res
|
||||
|
|
|
|||
|
|
@ -1,29 +1,25 @@
|
|||
/*REXX program compresses text using the LZW (Lempel─Ziv─Welch), and reconstitutes it.*/
|
||||
parse arg x /*get an optional argument from the CL.*/
|
||||
if x='' then x= '"There is nothing permanent except change." ─── Heraclitus [540-475 BC]'
|
||||
say 'original text=' x
|
||||
cypher=LZWc(x) /*compress text using the LZW algorithm*/
|
||||
say 'reconstituted=' LZWd(cypher)
|
||||
say ' LZW integers=' cypher
|
||||
parse arg x; if x=='' then /*get an optional argument from the CL.*/
|
||||
x= '"There is nothing permanent except change." ─── Heraclitus [540-475 BC]'
|
||||
say 'original text=' x /* [↑] Not specified? Then use default*/
|
||||
cypher= LZWc(x) /*compress text using the LZW algorithm*/
|
||||
say 'reconstituted=' LZWd(cypher) /*display the reconstituted string. */
|
||||
say ' LZW integers=' cypher /* " " LZW integers used. */
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
LZWc: procedure; parse arg y,,w $ @.; #=256 /*the LZW compress algorithm.*/
|
||||
do j=0 for #; _=d2c(j); @._=j; end /*j*/
|
||||
|
||||
do k=1 for length(y); _=w || substr(y, k, 1)
|
||||
if @._=='' then do; $=$ @.w; @._=#; #=#+1; w=substr(y,k,1)
|
||||
end
|
||||
else w=_
|
||||
end /*k*/
|
||||
return strip($ @.w) /*remove any superfluous blanks*/
|
||||
LZWc: procedure; parse arg y,,w $ @.; #= 256 /*LZW compress algorithm.*/
|
||||
do j=0 for #; _= d2c(j); @._= j; end /*j*/
|
||||
do k=1 for length(y)+1; z= w || substr(y, k, 1)
|
||||
if @.z=='' then do; $= $ @.w; @.z= #; #= # + 1; w= substr(y, k, 1); end
|
||||
else w= z
|
||||
end /*k*/; return substr($, 2) /*del leading blank.*/
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
LZWd: procedure; parse arg w y,,@.; #=256 /*the LZW decompress algorithm.*/
|
||||
do j=0 for #; @.j=d2c(j); end /*j*/
|
||||
$=@.w; w=$
|
||||
do k=1 for words(y); _=word(y, k)
|
||||
if @._\=='' | @.k==" " then ?=@._
|
||||
else if _==# then ?=w || left(w, 1)
|
||||
$=$ || ?
|
||||
@.#=w || left(?, 1); #=#+1; w=?
|
||||
end /*k*/
|
||||
return $
|
||||
LZWd: procedure; parse arg x y,,@.; #= 256 /*LZW decompress algorithm.*/
|
||||
do j=0 for #; @.j= d2c(j); end /*j*/
|
||||
$= @.x; w= $ /*#: is the dictionay size*/
|
||||
do k=1 for words(y); z= word(y, k)
|
||||
if @.z\=='' | @.k==" " then ?= @.z
|
||||
else if z==# then ?= w || left(w, 1)
|
||||
$= $ || ?
|
||||
@.#= w || left(?, 1); #= # + 1; w= ?
|
||||
end /*k*/; return $
|
||||
|
|
|
|||
105
Task/LZW-compression/Xojo/lzw-compression.xojo
Normal file
105
Task/LZW-compression/Xojo/lzw-compression.xojo
Normal file
|
|
@ -0,0 +1,105 @@
|
|||
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
|
||||
Loading…
Add table
Add a link
Reference in a new issue