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.




      plaintext$ = "TOBEORNOTTOBEORTOBEORNOT"
      encodeLZW$ = FNencodeLZW(plaintext$)
      FOR i% = 1 TO LEN(encodeLZW$) STEP 2
        PRINT ; ASCMID$(encodeLZW$,i%) + 256*ASCMID$(encodeLZW$,i%+1) " " ;
      NEXT
      PRINT ' FNdecodeLZW(encodeLZW$)
      END
 
      DEF FNencodeLZW(i$)
      LOCAL c%, d%, i%, l%, o$, w$, dict$()
      DIM dict$(4095)
      FOR i% = 0 TO 255 : dict$(i%) = CHR$(i%) : NEXT
      l% = i%
      i% = 1
      w$ = LEFT$(i$,1)
      REPEAT
        d% = 0
        REPEAT
          c% = d%
          IF i% > LEN(i$) EXIT REPEAT
          FOR d% = 1 TO l%-1
            IF w$ = dict$(d%) EXIT FOR
          NEXT d%
          IF d% < l% i% += 1 : w$ += MID$(i$, i%, 1)
        UNTIL d% >= l%
        dict$(l%) = w$ : l% += 1 : w$ = RIGHT$(w$)
        o$ += CHR$(c% MOD 256) + CHR$(c% DIV 256)
      UNTIL i% >= LEN(i$)
      = o$
 
      DEF FNdecodeLZW(i$)
      LOCAL c%, i%, l%, o$, t$, w$, dict$()
      DIM dict$(4095)
      FOR i% = 0 TO 255 : dict$(i%) = CHR$(i%) : NEXT
      l% = i%
      c% = ASC(i$) + 256*ASCMID$(i$,2)
      w$ = dict$(c%)
      o$ = w$
      IF LEN(i$) < 4 THEN = o$
      FOR i% = 3 TO LEN(i$) STEP 2
        c% = ASCMID$(i$,i%) + 256*ASCMID$(i$,i%+1)
        IF c% < l% t$ = dict$(c%) ELSE t$ = w$ + LEFT$(w$,1)
        o$ += t$
        dict$(l%) = w$ + LEFT$(t$,1)
        l% += 1
        w$ = t$
      NEXT
      = o$