트리는 자주 나오는 기호를 더 싸게 만든다.

(begin
  (define (append-symbols left right)
    (if (null? left)
        right
        (cons (car left) (append-symbols (cdr left) right))))
  (define (make-leaf symbol weight)
    (list 'leaf symbol weight))
  (define (leaf? object) (eq? (car object) 'leaf))
  (define (symbol-leaf leaf) (cadr leaf))
  (define (weight-leaf leaf) (caddr leaf))
  (define (left-branch tree) (car tree))
  (define (right-branch tree) (cadr tree))
  (define (symbols tree)
    (if (leaf? tree)
        (list (symbol-leaf tree))
        (caddr tree)))
  (define (weight tree)
    (if (leaf? tree)
        (weight-leaf tree)
        (car (cdr (cdr (cdr tree))))))
  (define (make-code-tree left right)
    (list left
          right
          (append-symbols (symbols left) (symbols right))
          (+ (weight left) (weight right))))
  (define (adjoin-weighted node nodes)
    (cond ((null? nodes) (list node))
          ((< (weight node) (weight (car nodes)))
           (cons node nodes))
          (else
           (cons (car nodes)
                 (adjoin-weighted node (cdr nodes))))))
  (define (make-leaf-set pairs)
    (if (null? pairs)
        '()
        (let ((entry (car pairs)))
          (adjoin-weighted
            (make-leaf (car entry) (cadr entry))
            (make-leaf-set (cdr pairs))))))
  (define (successive-merge nodes)
    (if (null? (cdr nodes))
        (car nodes)
        (successive-merge
          (adjoin-weighted
            (make-code-tree (car nodes) (cadr nodes))
            (cdr (cdr nodes))))))
  (define (symbol-in? symbol items)
    (cond ((null? items) #f)
          ((eq? symbol (car items)) #t)
          (else (symbol-in? symbol (cdr items)))))
  (define (encode-symbol symbol tree)
    (if (leaf? tree)
        '()
        (if (symbol-in? symbol (symbols (left-branch tree)))
            (cons 0 (encode-symbol symbol (left-branch tree)))
            (cons 1 (encode-symbol symbol (right-branch tree))))))
  (define tree
    (successive-merge
      (make-leaf-set '((A 4) (B 2) (D 1) (C 1)))))
  (list (weight tree)
        (symbols tree)
        (list (encode-symbol 'A tree)
              (encode-symbol 'B tree)
              (encode-symbol 'C tree)
              (encode-symbol 'D tree))))