<< Previous exercise (2.67) | Index | Next exercise (2.69) >>

 ;; ----------------------------------------------- 
 ;; EXERCISE 2.68 
 ;; ----------------------------------------------- 
 ;; helpers 
 (define (element-of-set? x set) 
   (cond ((null? set) false) 
         ((equal? x (car set)) true) 
         (else (element-of-set? x (cdr set))))) 
 (define (make-leaf symbol weight) 
   (list 'leaf symbol weight)) 
 (define (leaf? object) 
   (eq? (car object) 'leaf)) 
 (define (symbol-leaf x) (cadr x)) 
 (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-leaf x) (caddr x)) 
 (define (make-code-tree left right) 
   (list left 
         (append (symbols left) (symbols right)) 
         (+ (weight left) (weight right)))) 
 (define (weight tree) 
   (if (leaf? tree) 
       (weight-leaf tree) 
       (cadddr tree))) 
 (define (encode message tree) 
   (if (null? message) 
       (append (encode-symbol (car message) tree) 
               (encode (cdr message) tree)))) 
 ;; solution 
 (define (encode-symbol smb tree) 
   (define (branch-correct? branch) 
     (if (leaf? branch) 
         (equal? smb (symbol-leaf branch)) 
         (element-of-set? smb (symbols branch)))) 
   (let ((lb (left-branch tree)) 
         (rb (right-branch tree))) 
     (cond ((branch-correct? lb) 
            (if (leaf? lb) '(0) (cons 0 (encode-symbol smb lb)))) 
           ((branch-correct? rb) 
            (if (leaf? rb) '(1) (cons 1 (encode-symbol smb rb)))) 
           (else (error "bad symbol -- ENCODE-SYMBOL" bit))))) 
 ;; tests 
 (define sample-tree 
   (make-code-tree (make-leaf 'A 4) 
                    (make-leaf 'B 2) 
                    (make-code-tree (make-leaf 'D 1) 
                                    (make-leaf 'C 1))))) 
 (encode '(A D A B B C A) sample-tree) 
 ; (0 1 1 0 0 1 0 1 0 1 1 1 0) 


From a SICP newbie :-):

 (define (encode message tree) 
   (if (null? message) 
       (append (encode-symbol (car message) tree) 
               (encode (cdr message) tree)))) 
 (define (encode-symbol symbol tree) 
   (define (encode-symbol-1 result t) 
     (cond ((null? t) '()) 
           ((leaf? t) 
            (if (not (eq? symbol (symbol-leaf t))) 
            (let ((left-iter (encode-symbol-1 (cons 0 result) 
                                              (left-branch t))) 
                  (right-iter (encode-symbol-1 (cons 1 result) 
                                               (right-branch t)))) 
              (cond ((and (not (null? left-iter)) 
                          (not (null? right-iter))) 
                     (error "malformed tree -- ENCODE-SYMBOL" tree)) 
                    ((null? left-iter) right-iter) 
                    ((null? right-iter) left-iter) 
                    (else '())))))) 
   (let ((encoded-symbol (reverse (encode-symbol-1 '() tree)))) 
     (if (null? encoded-symbol) 
         (error "symbol not found -- ENCODE-SYMBOL" symbol) 
 (define sample-tree 
   (make-code-tree (make-leaf 'A 4) 
                    (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)) 
 (define sample-word (decode sample-message sample-tree)) 


1 ]=> (equal? (encode sample-word sample-tree) sample-message)

;Value: #t


 (define (encode-symbol symbol tree) 
     ((leaf? tree) '()) 
     ((member symbol (symbols tree)) 
       (let ((left (left-branch tree)) (right (right-branch tree))) 
          (if (member symbol (symbols left)) 
              (cons 0 (encode-symbol symbol left)) 
              (cons 1 (encode-symbol symbol right))))) 
     (else (error "bad symbol -- ENCODE-SYMBOL" symbol)))) 


 (define (encode-symbol symbol tree) 
   (if (not (element-of-set? symbol (symbols tree))) 
       (error "symbol cannot be encoded") 
       (if (leaf? tree) 
           (let ((left-set (symbols (left-branch tree))) 
                 (right-set (symbols (right-branch tree)))) 
             (cond ((element-of-set? symbol left-set) 
                    (cons 0 (encode-symbol symbol (left-branch tree)))) 
                   ((element-of-set? symbol right-set) 
                    (cons 1 (encode-symbol symbol (right-branch tree))))))))) 

I had the same approach. You do the error check for all nodes you visit. Since a node knows which symbols its children contain, you only need to check it once.

 (define (encode-symbol symbol tree) 
   (define (search symbol tree) 
     (let ((left-branch (left-branch tree)) 
           (right-branch (right-branch tree))) 
       (cond ((leaf? tree) '()) 
             ((element-of-set? symbol (symbols left-branch)) 
              (cons 0 (search symbol left-branch))) 
             ((element-of-set? symbol (symbols right-branch)) 
              (cons 1 (search symbol right-branch))))))  
   (if (not (element-of-set? symbol (symbols tree))) 
       (error "symbol not in tree -- ENCODE-SYMBOL" symbol) 
       (search symbol tree))) 

Short and simple. Also iterative.

 (define (encode-symbol symbol tree) 
   (define (encode-symbol-1 tree bits) 
     (cond ((and (leaf? tree) (eq? symbol (symbol-leaf tree))) 
            (reverse bits)) 
           ((memq symbol (symbols (left-branch tree))) 
            (encode-symbol-1 (left-branch tree) (cons 0 bits))) 
           ((memq symbol (symbols (right-branch tree))) 
            (encode-symbol-1 (right-branch tree) (cons 1 bits))) 
           (else (error "symbol not in tree: ENCODE-SYMBOL" symbol)))) 
   (encode-symbol-1 tree '())) 

Has both iterative and recursive

 (define (encode-symbol symbol tree) 
   (define (encode-1 symbol tree result) 
         (cond ((leaf? tree) result) 
                   ((element-of-set? symbol (symbols (left-branch tree))) 
                    (encode-1 symbol (left-branch tree) (append result '(0)))) 
                    (encode-1 symbol (right-branch tree) (append result '(1)))))) 
   (define (encode-1-rec symbol tree) 
         (cond ((leaf? tree) '()) 
                   ((element-of-set? symbol (symbols (left-branch tree))) 
                    (cons 0 (encode-1-rec symbol (left-branch tree)))) 
                    (cons 1 (encode-1-rec symbol (right-branch tree)))))) 
   (if (not (element-of-set? symbol (symbols tree))) 
           (encode-1-rec symbol tree))) 

use a intree? function

 (define (encode-symbol symbol branch) 
   (define (in? symbol symbols) 
     (if (null? symbols) false 
         (if (eq? symbol (car symbols)) true 
             (in? symbol (cdr symbols))))) 
   (define (intree? symbol tree) 
     (if (leaf? tree) (eq? symbol (symbol-leaf tree)) 
         (in? symbol (symbols tree)))) 
   (cond ((leaf? branch) '()) 
         ((intree? symbol (left-branch branch)) 
          (cons 0 (encode-symbol symbol (left-branch branch)))) 
         ((intree? symbol (right-branch branch)) 
          (cons 1 (encode-symbol symbol (right-branch branch)))) 
         (else (error "error")))) 

Use what we've learnt in chap 1 (procedural abstraction) to simplify the code

 (define (encode-symbol symbol tree) 
   (define (has-symbol side) 
     (element-of-set? symbol (symbols (side tree)))) 
   (define (check-branch branch bit) 
     (if (has-symbol branch) 
         (cons bit (encode-symbol symbol (branch tree))))) 
   (cond ((leaf? tree) '()) 
         ((check-branch left-branch 0)) 
         ((check-branch right-branch 1)) 
         (else (error "no such symbol" symbol)))) 

Although it's a little different from the SICP, it should be more efficient.

 ;; Convert a Huffman coded binary tree into a list 
 (define (tree->list bits branch) 
     (if (leaf? branch) 
         (list (cons 
             (symbol-leaf branch) 
             (reverse bits))) 
             (tree->list (cons 0 bits) (left-branch branch)) 
             (tree->list (cons 1 bits) (right-branch branch))))) 
 (define (encode message tree) 
     (define symbol-list (tree->list '() tree)) 
     (define (encode-symbol symbol symbol-list)    
         (let ((this-code 
                 (filter (lambda (x) (eq? (car x) symbol)) symbol-list))) 
             (if (null? this-code) 
                 (error "bad symbol -- find-code" symbol) 
                 (cdar this-code)))) 
     (define (encode-rec message symbol-list) 
         (if (null? message) 
                 (encode-symbol (car message) symbol-list) 
                 (encode-rec (cdr message) symbol-list)))) 
     (encode-rec message symbol-list))