Rosetta Code

LZW compression: Difference between revisions

Page Discussion

LZW compression (view source)

Revision as of 18:33, 26 March 2024

7,566 bytes added ,  2 months ago
Applesoft BASIC
m (syntax highlighting fixup automation)
(Applesoft BASIC)
 
(14 intermediate revisions by 7 users not shown)
Line 209:
end;
end Test;</syntaxhighlight>
 
=={{header|Applesoft BASIC}}==
{{trans|BBC BASIC}}
<syntaxhighlight lang="BASIC"> 0 PLAIN$ = "TOBEORNOTTOBEORTOBEORNOT"
10 GOSUB 200"ENCODE PLAIN$
20 FOR I = 1 TO LEN (ENCODE$) STEP 2
30 PRINT S$ ASC ( MID$ (ENCODE$,I)) + 256 * ASC ( MID$ (ENCODE$,I + 1));
40 LET S$ = " "
50 NEXT
60 PRINT
70 GOSUB 300"DECODE ENCODE$
80 PRINT PLAIN$;
90 END
 
100 FOR C = 0 TO 1E9 STEP 0
110 IF I > S THEN RETURN
120 FOR D = 1 TO L - 1
130 IF W$ < > DICT$(D) THEN NEXT D
140 IF D > = L THEN RETURN
150 LET I = I + 1
160 LET W$ = W$ + MID$ (PLAIN$,I,1)
170 LET C = D
180 NEXT C
190 RETURN
 
REM ENCODE PLAIN$ RETURN ENCODE$
200 IF NOT DI THEN DIM DICT$(4095)
210 FOR I = 0 TO 255:DICT$(I) = CHR$ (I): NEXT
220 LET DI = 1 : L = I : S = LEN (PLAIN$):ENCODE$ = ""
230 LET W$ = LEFT$ (PLAIN$,1)
240 FOR I = 1 TO 1E9 STEP 0
250 GOSUB 100
260 LET DICT$(L) = W$:L = L + 1:W$ = RIGHT$ (W$,1)
270 LET C% = C / 256:ENCODE$ = ENCODE$ + CHR$ (C - C% * 256) + CHR$ (C%)
280 IF I < = S THEN NEXT I
290 RETURN
 
REM DECODE ENCODE$ RETURN PLAIN$
300 IF NOT DI THEN DIM DICT$(4095)
310 FOR I = 0 TO 255:DICT$(I) = CHR$ (I): NEXT
320 LET DI = 1 : L = I
330 FOR I = L TO 4095:DICT$(I) = "": NEXT
340 LET C = ASC (ENCODE$) + 256 * ASC ( MID$ (ENCODE$,2))
350 LET W$ = DICT$(C)
360 LET PLAIN$ = W$
370 LET S = LEN (ENCODE$)
380 IF S < 4 THEN RETURN
400 FOR I = 3 TO S STEP 2
410 LET C = ASC ( MID$ (ENCODE$,I)) + 256 * ASC ( MID$ (ENCODE$,I + 1))
420 IF C < L THEN T$ = DICT$(C)
430 IF C > = L THEN T$ = W$ + LEFT$ (W$,1)
440 LET PLAIN$ = PLAIN$ + T$
450 LET DICT$(L) = W$ + LEFT$ (T$,1)
460 LET L = L + 1
470 LET W$ = T$
480 NEXT
490 RETURN</syntaxhighlight>
{{out}}
<pre>84 79 66 69 79 82 78 79 84 256 258 260 265 259 261 263
TOBEORNOTTOBEORTOBEORNOT</pre>
 
=={{header|AWK}}==
copy the following to standard input
<syntaxhighlight>
==comp
TOBEORNOTTOBEORTOBEORNOT
To be or not to be that is the question!
"There is nothing permanent except change." --- Heraclitus [540 -- 475 BCE]
 
==decomp
84,79,66,69,79,82,78,79,84,256,258,260,265,259,261,263
84,111,32,98,101,32,111,114,32,110,111,116,32,116,257,259,268,104,97,267,105,115,272,260,113,117,101,115,116,105,111,110,33
34,84,104,101,114,101,32,105,115,32,110,111,116,104,105,110,103,32,112,259,109,97,110,101,110,116,32,101,120,99,101,112,281,99,104,277,103,101,46,34,32,296,45,298,296,32,72,259,97,99,108,105,116,117,264,32,91,53,52,48,32,299,52,55,53,32,66,67,69,93
</syntaxhighlight>
 
<syntaxhighlight lang="AWK">
# ported from Python
BEGIN {
is_comp = 0
is_decomp = 0
}
 
{
if ($0 == "") next
if ($1 == "==comp") {
is_comp = 1
is_decomp = 0
print "\ncompressing..."
next
}
if ($1 == "==decomp") {
is_comp = 0
is_decomp = 1
print "\ndecompressing..."
next
}
if (is_comp) print compress($0)
if (is_decomp) print decompress($0)
}
function compress(str, dict_size, i, dictionary, w, result, len, uncompressed, c, wc ) {
dict_size = 256
for (i = 0; i <= dict_size; i++) dictionary[chr(i)] = i
w = ""
result = ""
len = split(str, uncompressed, "")
for (i = 1; i <= len; i++) {
c = uncompressed[i]
wc = w c
if (wc in dictionary) w = wc
else {
result = result "," dictionary[w]
dictionary[wc] = dict_size++
w = c
}
}
if (length(w)) result = result "," dictionary[w]
return substr(result,2)
return "[" substr(result,2) "]"
}
 
function decompress(str) {
dict_size = 256
for (i = 0; i <= dict_size; i++) dictionary[i] = chr(i)
result = ""
len = split(str, compressed, ",")
w = chr(compressed[1])
result = result w
for (i = 2; i <= len; i++) {
k = compressed[i]
if (k in dictionary) entry = dictionary[k]
else if (k == dict_size) entry = w substr(w,1,1)
else { entry = "*" }
result = result entry
dictionary[dict_size++] = w substr(entry,1,1)
w = entry
}
return result
}
 
function chr(c) {
return sprintf("%c", c + 0)
}</syntaxhighlight>
 
=={{header|Arturo}}==
Line 1,658 ⟶ 1,807:
"TOBEORNOTTOBEORTOBEORNOT"
true
</pre>
 
=={{header|EMal}}==
<syntaxhighlight lang="emal">
type LzwCompression
fun compress ← List by text uncompressed
List output ← int[]
text working ← Text.EMPTY
Map symbolTable ← text%int[].with(256, <int i|text%int(chr(i) => i))
for each text c in uncompressed
text augmented ← working + c
if symbolTable.has(augmented)
working ← augmented
else
symbolTable.insert(augmented, symbolTable.length)
int i ← symbolTable[working]
output.append(i)
working ← c
end
end
if not working.isEmpty()
int i ← symbolTable[working]
output.append(i)
end
return output
end
fun decompress ← text by List compressed
Map symbolTable ← int%text[].with(256, <int i|int%text(i => chr(i)))
text working ← symbolTable[compressed[0]]
text output ← *working
for each int i in compressed.extract(1)
text s
if symbolTable.has(i)
s ← symbolTable[i]
else if i æ symbolTable.length # cScSc problem
s ← working + working[0]
else
error(65, "Error decompressing")
end
output.append(s)
symbolTable.insert(symbolTable.length, working + s[0])
working ← s
end
return output
end
List compressed = compress("TOBEORNOTTOBEORTOBEORNOT")
writeLine(compressed)
text decompressed = decompress(compressed)
writeLine(decompressed)
</syntaxhighlight>
{{out}}
<pre>
[84,79,66,69,79,82,78,79,84,256,258,260,265,259,261,263]
TOBEORNOTTOBEORTOBEORNOT
</pre>
 
Line 4,271 ⟶ 4,474:
for ($i = 1; $i < count($com);$i++) {
$k = $com[$i];
if (isset($dictionary[$k])) {
$entry = $dictionary[$k];
} else {
Line 5,704 ⟶ 5,907:
if {$s eq [LZW::decode [LZW::encode $s]]} then {puts success} else {puts fail} ;# ==> success</syntaxhighlight>
 
=={{header|VBScript}}==
<syntaxhighlight lang="vb">
Option Explicit
Const numchars=127 'plain ASCII
 
Function LZWCompress(si)
Dim oDict, intMaxCode, i,z,ii,ss,strCurrent,strNext,j
Set oDict = CreateObject("Scripting.Dictionary")
ReDim a(Len(si))
intMaxCode = numchars
For i = 0 To numchars
oDict.Add Chr(i), i
Next
'strCurrent = ofread.ReadText(1)
strCurrent = Left(si,1)
j=0
For ii=2 To Len(si)
strNext = Mid(si,ii,1)
ss=strCurrent & strNext
If oDict.Exists(ss) Then
strCurrent = ss
Else
a(j)=oDict.Item(strCurrent) :j=j+1
intMaxCode = intMaxCode + 1
oDict.Add ss, intMaxCode
strCurrent = strNext
End If
Next
a(j)=oDict.Item(strCurrent)
ReDim preserve a(j)
LZWCompress=a
Set oDict = Nothing
End Function
 
Function lzwUncompress(sc)
Dim intNext, intCurrent, intMaxCode, i,ss,istr,s,j
s=""
reDim dict(1000)
intMaxCode = numchars
For i = 0 To numchars : dict(i)= Chr(i) : Next
intCurrent=sc(0)
For j=1 To UBound(sc)
ss=dict(intCurrent)
s= s & ss
intMaxCode = intMaxCode + 1
intnext=sc(j)
If intNext<intMaxCode Then
dict(intMaxCode)=ss & Left(dict(intNext), 1)
Else
dict(intMaxCode)=ss & Left(ss, 1)
End If
intCurrent = intNext
Next
s= s & dict(intCurrent)
lzwUncompress=s
End function
 
Sub printvec(a)
Dim s,i,x
s="("
For i=0 To UBound (a)
s=s & x & a(i)
x=", "
Next
WScript.echo s &")"
End sub
 
Dim a,b
b="TOBEORNOTTOBEORTOBEORNOT"
WScript.Echo b
a=LZWCompress (b)
printvec(a)
WScript.echo lzwUncompress (a )
wscript.quit 1
</syntaxhighlight>
{{out}}
<small>
<pre>
 
TOBEORNOTTOBEORTOBEORNOT
(84, 79, 66, 69, 79, 82, 78, 79, 84, 128, 130, 132, 137, 131, 133, 135)
TOBEORNOTTOBEORTOBEORNOT
</pre>
</small>
=={{header|Wren}}==
{{trans|Kotlin}}
<syntaxhighlight lang="ecmascriptwren">class LZW {
/* Compress a string to a list of output symbols. */
static compress(uncompressed) {
Mmphosis
413

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/327794...362950"