1 665c255d 2023-08-04 jrmu (define (make-leaf symbol weight)
2 665c255d 2023-08-04 jrmu (list 'leaf symbol weight))
3 665c255d 2023-08-04 jrmu (define (leaf? object)
4 665c255d 2023-08-04 jrmu (eq? (car object) 'leaf))
5 665c255d 2023-08-04 jrmu (define (symbol-leaf x) (cadr x))
6 665c255d 2023-08-04 jrmu (define (weight-leaf x) (caddr x))
8 665c255d 2023-08-04 jrmu (define (make-code-tree left right)
11 665c255d 2023-08-04 jrmu (append (symbols left) (symbols right))
12 665c255d 2023-08-04 jrmu (+ (weight left) (weight right))))
14 665c255d 2023-08-04 jrmu (define (left-branch tree) (car tree))
15 665c255d 2023-08-04 jrmu (define (right-branch tree) (cadr tree))
16 665c255d 2023-08-04 jrmu (define (symbols tree)
17 665c255d 2023-08-04 jrmu (if (leaf? tree)
18 665c255d 2023-08-04 jrmu (list (symbol-leaf tree))
19 665c255d 2023-08-04 jrmu (caddr tree)))
20 665c255d 2023-08-04 jrmu (define (weight tree)
21 665c255d 2023-08-04 jrmu (if (leaf? tree)
22 665c255d 2023-08-04 jrmu (weight-leaf tree)
23 665c255d 2023-08-04 jrmu (cadddr tree)))
25 665c255d 2023-08-04 jrmu (define (decode bits tree)
26 665c255d 2023-08-04 jrmu (define (decode-1 bits branch)
27 665c255d 2023-08-04 jrmu (cond ((if (and (null? bits)
28 665c255d 2023-08-04 jrmu (leaf? branch))
29 665c255d 2023-08-04 jrmu (list (symbol-leaf branch))
30 665c255d 2023-08-04 jrmu ;; ((null? branch)
31 665c255d 2023-08-04 jrmu ;; ("error: symbol not found"))
32 665c255d 2023-08-04 jrmu ((leaf? branch)
33 665c255d 2023-08-04 jrmu (cons (symbol-leaf branch)
34 665c255d 2023-08-04 jrmu (decode-1 (cdr bits)
35 665c255d 2023-08-04 jrmu (choose-branch (car bits) tree))))
36 665c255d 2023-08-04 jrmu (else (decode-1 (cdr bits)
37 665c255d 2023-08-04 jrmu (choose-branch (car bits) branch)))))
38 665c255d 2023-08-04 jrmu (decode-1 bits tree))
87 665c255d 2023-08-04 jrmu (define (decode bits tree)
88 665c255d 2023-08-04 jrmu (define (decode-1 bits current-branch)
89 665c255d 2023-08-04 jrmu (if (null? bits)
91 665c255d 2023-08-04 jrmu (let ((next-branch
92 665c255d 2023-08-04 jrmu (choose-branch (car bits) current-branch)))
93 665c255d 2023-08-04 jrmu (if (leaf? next-branch)
94 665c255d 2023-08-04 jrmu (cons (symbol-leaf next-branch)
95 665c255d 2023-08-04 jrmu (decode-1 (cdr bits) tree))
96 665c255d 2023-08-04 jrmu (decode-1 (cdr bits) next-branch)))))
97 665c255d 2023-08-04 jrmu (decode-1 bits tree))
98 665c255d 2023-08-04 jrmu (define (choose-branch bit branch)
99 665c255d 2023-08-04 jrmu (cond ((= bit 0) (left-branch branch))
100 665c255d 2023-08-04 jrmu ((= bit 1) (right-branch branch))
101 665c255d 2023-08-04 jrmu (else (error "bad bit -- CHOOSE-BRANCH" bit))))
