;; https://rosettacode.org/wiki/LZW_compression
;; "The Lempel-Ziv-Welch (LZW) algorithm provides loss-less data compression."

(to (show-lzw text)
  (for each [(code (encode text))]
    (if (<= code 255)
        (text<- (rune<- code))
        code)))

(let default-codebook (each text<- ((rune<- 0) .span 256)))

(to (encode text @(optional codebook))
  (let codes ((or codebook default-codebook) .inverse))
  (let result (flexarray<-))
  (let chunk (for amass [(chunk "") (rune text)]
               (let t1 rune.text)
               (let chunk-1 (chain chunk t1))
               (hm (when (codes .maps? chunk-1)
                     chunk-1)
                   (else
                     (result .push! (codes chunk))
                     (codes .set! chunk-1 codes.count)
                     t1))))
  (unless chunk.none?
    (result .push! (codes chunk)))
  result.values)

(to (decode codes @(optional codebook))
  ("" .join (chunked-decode codes (or codebook default-codebook))))

(to (chunked-decode codes codebook)
  (hm (if codes.none? '())
      (else (let chunks (flexarray<-list codebook))
            (let output (flexarray<-))
            (do decoding [(chunk (chunks codes.first))
                          (codes codes.rest)]
              (output .push! chunk)
              (when codes.some?
                (let code codes.first)
                (chunks .push! chunk)
                (let new-chunk (chunks code))
                (chunks .set! chunks.count.-1
                        (chain chunk (new-chunk .from 0 1)))
                (decoding (chunks code) codes.rest)))
            output.values)))

(out .print (show-lzw "TOBEORNOTTOBEORTOBEORNOT"))

(let m "XXXXXXXXXXXX")
(out .print (show-lzw m))
(let x (encode m))
(out .print (chunked-decode x default-codebook))

(surely (= m (decode x)))

(let p2 "TOBEORNOTTOBEORTOBEORNOT")
(let m2 (encode p2))
(let x2 (decode m2))
(surely (= x2 p2))
