6 (else (memq item (cdr x)))))
9 (define (make-leaf leaf weight)
10 (list 'leaf leaf weight))
12 (define (leaf? object)
13 (eq? (car object) 'leaf))
15 (define (symbol-leaf object)
18 (define (weight-leaf object)
21 ;;;; constructors and selectors
23 ;; tree node consists of a list which has left branch, right branch
24 ;; set of symbols in left and right and total weight
25 (define (make-code-tree left right)
28 (append (symbols left)
33 (define (left-branch tree) (car tree))
35 (define (right-branch tree) (cadr tree))
37 (define (symbols tree)
39 (list (symbol-leaf tree))
48 (define (decode bits tree)
49 (define (decode-1 bits current-branch)
52 (let ([next-branch (choose-branch (car bits) current-branch)])
53 (if (leaf? next-branch)
54 (cons (symbol-leaf next-branch)
55 (decode-1 (cdr bits) tree))
56 (decode-1 (cdr bits) next-branch)))))
59 (define (choose-branch bit tree)
60 (cond [(= bit 0) (left-branch tree)]
61 [(= bit 1) (right-branch tree)]
62 [else (error "Bad bit -- CHOOSE-BRANCH" bit)]))
64 (define (adjoin-set x set)
65 (cond [(null? set) (list x)]
66 [(< (weight x) (weight (car set))) (cons x set)]
68 (adjoin-set x (cdr set)))]))
70 (define (make-leaf-set pairs)
73 (let ([pair (car pairs)])
74 (adjoin-set (make-leaf (car pair)
76 (make-leaf-set (cdr pairs))))))
78 (provide make-code-tree