my attempt to do the exercises in sicp.

Tuesday, July 29, 2008

sicp exercise 2.68


;; Exercise 2.68.  The encode procedure takes as arguments a message and a tree and produces the list of bits that gives the encoded message.

;; (define (encode message tree)
;;   (if (null? message)
;;       '()
;;       (append (encode-symbol (car message) tree)
;;               (encode (cdr message) tree))))

;; Encode-symbol is a procedure, which you must write, that returns the list of bits that encodes a given symbol according to a given tree. You should design encode-symbol so that it signals an error if the symbol is not in the tree at all. Test your procedure by encoding the result you obtained in exercise 2.67 with the sample tree and seeing whether it is the same as the original sample message.

(define false #f)
(define true  #t)

(define (make-leaf symbol weight)
  (list 'leaf symbol weight))
(define (leaf? object)
  (eq? (car object) 'leaf))
(define (symbol-leaf x) (cadr x))
(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 (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)
      (cadddr tree)))


(define (decode bits tree)
  (define (decode-1 bits current-branch)
    (if (null? bits)
        '()
        (let ((next-branch
               (choose-branch (car bits) current-branch)))
          (if (leaf? next-branch)
              (cons (symbol-leaf next-branch)
                    (decode-1 (cdr bits) tree))
              (decode-1 (cdr bits) next-branch)))))
  (decode-1 bits tree))
(define (choose-branch bit branch)
  (cond ((= bit 0) (left-branch branch))
        ((= bit 1) (right-branch branch))
        (else (error "bad bit -- CHOOSE-BRANCH" bit))))

(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-iter symbol sub-tree)
    (cond ((leaf? sub-tree) (list))
          ((element-of? symbol (symbols (left-branch sub-tree)))
               (cons '0 (encode-symbol-iter symbol (left-branch sub-tree))))
          ((element-of? symbol (symbols (right-branch sub-tree)))
               (cons '1 (encode-symbol-iter symbol (right-branch sub-tree))))
          (else (error "error not present"))))
  (if (element-of? symbol (symbols tree))
      (encode-symbol-iter symbol tree)
      (error "error not present")))
(define (element-of? symbol set)
  (cond ((null? set) false)
        ((eq? symbol (car set)) true)
        (else (element-of? symbol (cdr set)))))


(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 encoded-message '(0 1 1 0 0 1 0 1 0 1 1 1 0))


(display sample-tree) (newline)
(display encoded-message) (newline)
(display (decode encoded-message sample-tree)) (newline)
(display (encode '(A D A B B C A) sample-tree)) (newline)


No comments: