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))))))))) 
  

anonymous

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 '()))