86 lines
2.6 KiB
Scheme
86 lines
2.6 KiB
Scheme
; Get the list reference number for a member or #f if not found
|
|
(define (member-string-ref m l)
|
|
(define r #f)
|
|
(let loop ((i 0))
|
|
(if (< i (length l))
|
|
(if (not (string=? (list-ref l i) m))
|
|
(loop (+ i 1))
|
|
(set! r i))))
|
|
r)
|
|
|
|
;; Compress a string with LZW
|
|
(define (lzw-compress uncompressed)
|
|
(define dictionary '())
|
|
(define n 0)
|
|
(define result '())
|
|
(set! uncompressed (string->list uncompressed))
|
|
|
|
;; Setup Dictionary
|
|
(let dict-setup ((c 0))
|
|
(if (> 256 c)
|
|
(begin
|
|
(set! dictionary (append dictionary
|
|
(list (string (integer->char c)))))
|
|
(set! n (+ n 1))
|
|
(dict-setup (+ c 1)))))
|
|
|
|
;; Compress the string
|
|
(let compress ((w "") (ci 0))
|
|
(define c (string (list-ref uncompressed ci)))
|
|
(define wc "")
|
|
(set! wc (string-append w c))
|
|
(if (member-string-ref wc dictionary)
|
|
(set! w wc)
|
|
(begin
|
|
(set! result (append result
|
|
(list (member-string-ref w dictionary))))
|
|
(set! dictionary (append dictionary (list wc)))
|
|
(set! n (+ n 1))
|
|
(set! w c)))
|
|
(if (eqv? ci (- (length uncompressed) 1))
|
|
(set! result (append result
|
|
(list (member-string-ref w dictionary))))
|
|
(compress w (+ ci 1))))
|
|
result)
|
|
|
|
;; Decompress a LZW compressed string (input should be a list of integers)
|
|
(define (lzw-decompress compressed)
|
|
(define dictionary '())
|
|
(define n 0)
|
|
(define result "")
|
|
|
|
;; Setup Dictionary
|
|
(let dict-setup ((c 0))
|
|
(if (> 256 c)
|
|
(begin
|
|
(set! dictionary (append dictionary
|
|
(list (string (integer->char c)))))
|
|
(set! n (+ n 1))
|
|
(dict-setup (+ c 1)))))
|
|
|
|
;; Decompress the list
|
|
(let decompress ((k (list-ref compressed 0)) (ci 0))
|
|
(define kn #f)
|
|
;; Add to dictionary
|
|
(if (> (length compressed) (+ ci 1))
|
|
(begin
|
|
(set! kn (list-ref compressed (+ ci 1)))
|
|
(if (< kn (length dictionary))
|
|
(set! dictionary
|
|
(append dictionary
|
|
(list (string-append
|
|
(list-ref dictionary k)
|
|
(string (string-ref (list-ref dictionary kn) 0)))))))))
|
|
|
|
;; Build the resulting string
|
|
(set! result (string-append result (list-ref dictionary k)))
|
|
|
|
(if (not (eqv? ci (- (length compressed) 1)))
|
|
(decompress kn (+ ci 1))))
|
|
result)
|
|
|
|
(define compressed (lzw-compress "TOBEORNOTTOBEORTOBEORNOT"))
|
|
(display compressed) (newline)
|
|
(define decompressed (lzw-decompress compressed))
|
|
(display decompressed) (newline)
|