2.69

练习 2.69 下面过程以一个符号-频度对偶表为参数（其中没有任何符号出现在多于一个对偶中），并根据Huffman算法生成Huffman编码树。

 
(define (generate-huffman-tree pairs)
  (successive-merge (make-leaf-set pairs))
  )
​x
 
#<undef>

其中的make-leaf-set是前面给出的过程，它将对偶表变换为叶的有序集，successive-merge是需要你写的过程，它使用make-code-tree反复归并集合中具有最小权重的元素，直至集合里只剩下一个元素为止。这个元素就是我们所需要的Huffman树。（这一过程稍微有点技巧性，但并不很复杂。如果你正在设计的过程变得很复杂，那么几乎可以肯定是在什么地方搞错了。你应该尽可能地利用有序集合表示这一事实。）

make-leaf-set的代码如下：

 
(define (make-leaf-set pairs)
  (if (null? pairs)
      '()
      (let ((pair (car pairs)))
        (adjoin-set 
         (make-leaf (car pair) (cadr pair))
         (make-leaf-set (cdr pairs))
         )
        )
      )
  )
 
#<undef>

adjoin-set 代码如下：

 
(define (adjoin-set x set)
  (cond
   ((null? set) (list x))
   ((<= (weight x) (weight (car set))) (cons x set))
   (else (cons (car set) (adjoin-set x (cdr set))))
   )
  )
 
#<undef>

上一练习中的代码：

 
(define (leaf? object) (eq? (car object) 'leaf))
​
(define (symbol-leaf x) (cadr x))
(define (weight-leaf x) (caddr x))
​
(define (left-branch tree) (car tree))
(define (right-branch tree) (cadr tree))
​
(define (encode-symbol-with-code char tree code)    
  (if (leaf? tree)
      (if (eq? (symbol-leaf tree) char)
          (list code)
          '()
          )
​
      (let
        (
         (left (encode-symbol-with-code char (left-branch tree) '0))
         (right (encode-symbol-with-code char (right-branch tree) '1))  
         )
​
        (let
          (
           (res (append left right))
           )
​
          (if (null? res)
              '()
              (append (list code) res) 
              )
          )
        )
      )
  )
​
(define (encode-symbol char tree)
  ; (encode-symbol-with-code char tree '0)
​
  (if (leaf? tree)
      (if (eq? (symbol-leaf tree) char)
          (list '0)
          '()
          )
​
      (let
        (
         (left-res (encode-symbol-with-code char (left-branch tree) '0))
         (right-res (encode-symbol-with-code char (right-branch tree) '1))
         )
​
        (append left-res right-res)
        )
      )
  )
​
(encode-symbol 'A (list 'leaf 'A 1))
 
(0)

decode 的代码如下：

 
(define (decode bits tree)
  (define (decode-1 bits current-branch)
    (if (null? bits)
        '()
        (let 
          (
           (next-branch
            (choose-branch 
             (car bits)
             current-branch
             )
            )
           )
​
          (if (leaf? next-branch)
              (cons 
               (symbol-leaf next-branch) 
               (decode-1 (cdr bits) tree)
               )
              (decode-1 (cdr bits) next-branch)
              )
          )
        )
    )
​
  (decode-1 bits tree)
  )
​
(define (choose-branch bit branch)
  (cond 
   ((= bit 0) (left-branch branch))
   ((= bit 1) (right-branch branch))
   (else
    (error "bad bit -- CHOOSE-BRANCH" bit)
    )
   )
  )
​
(define (make-leaf symbol weight)
  (list 'leaf symbol weight)
  )
​
(define (make-code-tree left right)
  (list 
   left
   right
   (append (symbols left) (symbols right))
   (+ (weight left) (weight right))
   )
  )
​
(define (symbols tree)
  (if (leaf? tree)
      (list (symbol-leaf tree))
      (caddr tree))
  )
​
(define (weight tree)
  (if 
   (leaf? tree)
   (weight-leaf tree)
   (cadddr tree)
   )
  )
​
(define sample-tree
  (make-code-tree 
   (make-leaf 'A 4)
   (make-code-tree 
    (make-leaf 'B 2)
    (make-code-tree
     (make-leaf 'D 1)
     (make-leaf 'C 1)
     )
    )
   )
  )
​
(define sample-message '(0 1 1 0 0 1 0 1 0 1 1 1 0))
​
(decode sample-message sample-tree)
 
('A 'D 'A 'B 'B 'C 'A)

 
(define sample-tree
  (make-code-tree 
   (make-leaf 'A 4)
   (make-code-tree 
    (make-leaf 'B 2)
    (make-code-tree
     (make-leaf 'D 1)
     (make-leaf 'C 1)
     )
    )
   )
  )
​
​
(encode-symbol 'A sample-tree)
 
(0)

测试一下 make-leaf-set：

 
(define sorted (make-leaf-set (list (list 'A 8) (list 'B 4) (list 'C 2) (list 'D 1))))
​
sorted
 
(('leaf 'D 1) ('leaf 'C 2) ('leaf 'B 4) ('leaf 'A 8))

 
(define p (list
           (list 'A 2)
           (list 'NA 16)
           (list 'BOOM 1)
           (list 'SHA 3)
           (list 'GET 2)
           (list 'YIP 9)
           (list 'JOB 2)
           (list 'WAH 1)
           ))
​
(make-leaf-set 
 p
 )
 
(('leaf 'BOOM 1) ('leaf 'WAH 1) ('leaf 'A 2) ('leaf 'GET 2) ('leaf 'JOB 2) ('leaf 'SHA 3) ('leaf 'YIP 9) ('leaf 'NA 16))

果然能将对偶表变成叶的有序集合！现在来写successive-merge：

 
(define (successive-merge sorted-leaf-set)
  (if (<= (length sorted-leaf-set) 1)
      sorted-leaf-set
      (let
        (
         (left (car sorted-leaf-set))
         (right (cadr sorted-leaf-set))
         )
​
        (let 
          (
           (new-leaf (make-code-tree left right))
           (rest (cddr sorted-leaf-set))
           )
​
          (if (null? rest) 
              new-leaf 
              (successive-merge 
               (adjoin-set new-leaf rest)
               )
              )
          )
        )
      )
  )
​
(successive-merge sorted)
 
(((('leaf 'D 1) ('leaf 'C 2) ('D 'C) 3) ('leaf 'B 4) ('D 'C 'B) 7) ('leaf 'A 8) ('D 'C 'B 'A) 15)

 
(generate-huffman-tree p)
 
(('leaf 'NA 16) (('leaf 'YIP 9) (((('leaf 'BOOM 1) ('leaf 'WAH 1) ('BOOM 'WAH) 2) ('leaf 'A 2) ('BOOM 'WAH 'A) 4) (('leaf 'SHA 3) (('leaf 'GET 2) ('leaf 'JOB 2) ('GET 'JOB) 4) ('SHA 'GET 'JOB) 7) ('BOOM 'WAH 'A 'SHA 'GET 'JOB) 11) ('YIP 'BOOM 'WAH 'A 'SHA 'GET 'JOB) 20) ('NA 'YIP 'BOOM 'WAH 'A 'SHA 'GET 'JOB) 36)