src/sicp/ex2_68.rkt

   1 #lang racket
   2
   3 (require "ch2_3.rkt"
   4          rackunit)
   5
   6 (define sample-tree
   7   (make-code-tree (make-leaf 'A 4)
   8                   (make-code-tree
   9                    (make-leaf 'B 2)
  10                    (make-code-tree (make-leaf 'D 1)
  11                                    (make-leaf 'C 1)))))
  12
  13 (define sample-bits '(0 1 1 0 0 1 0 1 0 1 1 1 0))
  14
  15 (define sample-message (decode sample-bits sample-tree))
  16
  17 (define (encode message tree)
  18   (if (null? message)
  19       '()
  20       (append (encode-symbol (car message) tree)
  21               (encode (cdr message) tree))))
  22
  23 (define (encode-symbol symbol tree)
  24   (cond
  25     [(and (leaf? tree)
  26           (eqv? (symbol-leaf tree) symbol)) '()]
  27     [(member? symbol (symbols (left-branch tree))) (cons 0 (encode-symbol symbol (left-branch tree)))]
  28     [(member? symbol (symbols (right-branch tree))) (cons 1 (encode-symbol symbol (right-branch tree)))]
  29     [(not (member? symbol (symbols tree))) (error "Symbol not in the tree -- ENCODE-SYMBOL " symbol)]))
  30
  31 (define (member? x set)
  32   (cond
  33     [(null? set) #f]
  34     [(eqv? x (car set)) #t]
  35     [else (member? x (cdr set))]))
  36
  37 ;;; a simple test. encode-decode should give me back the same symbols.
  38 (check equal?
  39        (decode (encode sample-message
  40                        sample-tree)
  41                sample-tree)
  42        sample-message)
  43
  44 (provide encode)