sicp-ex-2.68


 ;; ----------------------------------------------- 
 ;; 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 
         right 
         (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-code-tree 
                    (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) 

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


ff0000

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))) 
                '() 
                result)) 
           (else 
            (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) 
         encoded-symbol))) 
  
 (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)) 
  
 (define sample-word (decode sample-message sample-tree)) 

testing:

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

;Value: #t

eliyak

  
  
  
 (define (encode-symbol symbol tree) 
   (cond 
     ((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)))) 
  

Siki

  
  
  
 (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)))) 
                   (else 
                    (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)))) 
                   (else 
                    (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"))))