ACL(2) 3.6 ランレングス符号
休みの間に、ACLを読み進めてたので、コーディングしてきます。3章のランレングス符号に挑戦します。
SICPでハフマン符号化木をやったけど、ランレングス符号の方がずっと簡単な圧縮方法っぽい。ウェイトレスと4人の客の話が面白い。
圧縮を写経
まずは、動きを確認するために、圧縮を写経します。
(define (compress x) (if (pair? x) (compr (car x) 1 (cdr x)) x)) (define (compr elt n lst) (if (null? lst) (list (n-elts elt n)) (let ((next (car lst))) (if (eq? next elt) (compr elt (+ n 1) (cdr lst)) (cons (n-elts elt n) (compr next 1 (cdr lst))))))) (define (n-elts elt n) (if (> n 1) (list n elt) elt))
コードを見てもイマイチなので、動かしてみた方がわかりやすい。
(compress '(A A A A B B B C D D D)) ; ((4 A) (3 B) C (3 D))
ふむふむ。4個のAと3個のBとCと3個のD。わかりやすい!!
ハフマン符号化木は連続してなくても圧縮出来たけど、ランレングス符号は連続した記号を圧縮出来るみたい。木を使わないのでかなり簡単。連続したデータの多い画像ファイルの圧縮には最適かも。
解凍してみる
では、解凍を自分で書いてみる。
(define (uncompless lst) (fold-right (lambda (a b) (if (pair? a) (append (list-tabulate (car a) (lambda (x) (cadr a))) b) (cons a b))) '() lst))
appendを使わなくても出来ると思う。
解凍してみると、
(uncompless '((4 A) (3 B) C (3 D))) ; (A A A A B B B C D D D)
おぉ、元に戻った!!
ランレングス符号はかなり直感的でわかりやすい感じなので、圧縮入門にはいい感じ。