The Lempel-Ziv-Welch (LZW) algorithm provides loss-less data compression.

You can read a complete description of it in the   Wikipedia article   on the subject.   It was patented, but it entered the public domain in 2004.




CONST lzw_data$ = "TOBEORNOTTOBEORTOBEORNOT"
 
PRINT "LZWData: ", lzw_data$
encoded$ = Encode_LZW$(lzw_data$)
PRINT "Encoded: ", encoded$
PRINT "Decoded: ", Decode_LZW$(encoded$)
 
'----------------------------------------------------------
 
FUNCTION Encode_LZW$(sample$)
 
    LOCAL dict ASSOC int
    LOCAL ch$, buf$, result$
    LOCAL nr, x
 
    FOR nr = 0 TO 255
        dict(CHR$(nr)) = nr
    NEXT
 
    FOR x = 1 TO LEN(sample$)
 
        ch$ = MID$(sample$, x, 1)
 
        IF dict(buf$ & ch$) THEN
            buf$ = buf$ & ch$
        ELSE
            result$ = APPEND$(result$, 0, STR$(dict(buf$)))
            dict(buf$ & ch$) = nr
            INCR nr
            buf$ = ch$
        END IF
    NEXT
 
    result$ = APPEND$(result$, 0, STR$(dict(buf$)))
 
    RETURN result$
 
END FUNCTION
 
'----------------------------------------------------------
 
FUNCTION Decode_LZW$(sample$)
 
    LOCAL list$ ASSOC STRING
    LOCAL old$, ch$, x$, out$, result$
    LOCAL nr
 
    FOR nr = 0 TO 255
        list$(STR$(nr)) = CHR$(nr)
    NEXT
 
    old$ = TOKEN$(sample$, 1)
 
    ch$ = list$(old$)
    result$ = ch$
 
    FOR x$ IN LAST$(sample$, 1)
 
        IF NOT(LEN(list$(x$))) THEN
            out$ = list$(old$)
            out$ = out$ & ch$
        ELSE
            out$ = list$(x$)
        END IF
 
        result$ = result$ & out$
        ch$ = LEFT$(out$, 1)
        list$(STR$(nr)) = list$(old$) & ch$
 
        INCR nr
        old$ = x$
    NEXT
 
    RETURN result$
 
END FUNCTION