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)

おぉ、元に戻った!!

ランレングス符号はかなり直感的でわかりやすい感じなので、圧縮入門にはいい感じ。