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.




 
Module BBCtrans {
      \\ LZW compression
      plaintext$="TOBEORNOTTOBEORTOBEORNOT"
      Function encodeLZW$(i$) {
                  Def long c, d, i, l, o$, w$
                  DIM dict$(0 to 4095)
                  FOR i = 0 TO 255 : dict$(i) = CHR$(i) : NEXT i
                  l = i
                  i = 1
                  w$ = LEFT$(i$,1)
                  REPEAT{
                          d = 0
                          REPEAT {
                                  c = d
                                  IF i > LEN(i$) THEN EXIT 
                                  FOR d = 1 TO l-1
                                    IF w$ = dict$(d) THEN EXIT
                                  NEXT d
                                  IF d < l Then i += 1 : w$ += MID$(i$, i, 1)
                        } UNTIL d >= l
                          dict$(l) = w$ : l += 1 : w$ = RIGHT$(w$, 1)
                          o$ += CHR$(c MOD 256) + CHR$(c DIV 256)
                  } UNTIL i > LEN(i$)
                  = o$
      }
      encodeLZW$ = encodeLZW$(plaintext$)
      FOR i = 1 TO LEN(encodeLZW$) STEP 2
              PRINT ASC(MID$(encodeLZW$,i)) + 256*ASC(MID$(encodeLZW$,i+1));" ";
      NEXT i
      Print
      Function decodeLZW$(i$) {
                  Def c, i, l, o$, t$, w$
                  DIM dict$(0 to 4095)
                  FOR i = 0 TO 255 : dict$(i) = CHR$(i) : NEXT i
                  l = i
                  c = ASC(i$) + 256*ASC(MID$(i$,2))
                  w$ = dict$(c)
                  o$ = w$
                  IF LEN(i$) < 4 THEN = o$
                  FOR i = 3 TO LEN(i$) STEP 2
                    c = ASC(MID$(i$,i)) + 256*ASC(MID$(i$,i+1))
                    IF c < l Then { t$ = dict$(c) } ELSE t$ = w$ + LEFT$(w$,1)
                    o$ += t$
                    dict$(l) = w$ + LEFT$(t$,1)
                    l += 1
                    w$ = t$
                  NEXT i
                  = o$
      }
      Print decodeLZW$(encodeLZW$)
}
BBCtrans
 