Data commit

Task/LZW-compression/Scheme/lzw-compression.ss

@@ -0,0 +1,85 @@
+; 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)