]> git.rkrishnan.org Git - sicp.git/blob - src/sicp/ex2_68.rkt
rewrite `quote->cons' using `match'.
[sicp.git] / 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)