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)

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