]> git.rkrishnan.org Git - sicp.git/blob - src/sicp/ch2_3_3.rkt
Solution to 4.44. A bit too verbose. Can be improved by better
[sicp.git] / src / sicp / ch2_3_3.rkt
1 #lang racket/load
2
3 (define (element-of-set? x set)
4   (cond ((null? set) #f)
5         ((equal? x (car set)) #t)
6         (else (element-of-set? x (cdr set)))))
7
8 (define (adjoin-set x set)
9   (cond ((element-of-set? x set) set)
10         (else (cons x set))))
11
12 (define (intersection-set set1 set2)
13   (cond ((or (null? set1) (null set2)) '())
14         ((element-of-set? (car set1) set2) (cons (car set1) (intersection-set (cdr set1) set2)))
15         (else (intersection-set (cdr set1) set2))))
16
17 ;;; huffman tree
18 (define (make-leaf symbol weight)
19   (list 'leaf symbol weight))
20 (define (leaf? node)
21   (eq? (car node) 'leaf))
22 (define (symbol-leaf node)
23   (car (cdr node)))
24 (define (weight-leaf node)
25   (car (cdr (cdr node))))
26
27 (define (make-code-tree left right)
28   (list left
29         right
30         (append (symbols left) (symbols right))
31         (+ (weight left) (weight right))))
32
33 (define (left-branch tree) (car tree))
34 (define (right-branch tree) (car (cdr tree)))
35 (define (symbols tree)
36   (if (leaf? tree)
37       (list (symbol-leaf tree))
38       (car (cdr (cdr tree)))))
39 (define (weight tree)
40   (if (leaf? tree)
41       (weight-leaf tree)
42       (car (cdr (cdr (cdr tree))))))
43
44 ;; decoding
45 (define (decode bits tree)
46   (define (decode-1 bits current-branch)
47     (if (null? bits)
48         '()
49         (let ((next-branch (choose-branch (car bits) tree)))
50           (if (leaf? next-branch)
51               (cons (symbol-leaf next-branch)
52                     (decode-1 (cdr bits) tree))
53               (decode-1 (cdr bits) next-branch)))))
54   (decode-1 bits tree))
55
56 (define (choose-branch bit tree)
57   (cond ((= bit 0) (left-branch tree))
58         ((= bit 1) (right-branch tree))
59         (else (error "bad bit -- choose-branch" bit))))
60
61 ;; sets of weighted elements
62
63 ;; arrange items in the increasing order of weight
64 (define (adjoin-set x set)
65   (cond ((null? set) (list x))
66         ((< (weight x) (weight (car set))) (cons x set))
67         (else (cons (car set)
68                     (adjoin-set x (cdr set))))))
69
70 (define (make-leaf-set pairs)
71   (if (null? pairs)
72       '()
73       (let ((pair (car pairs)))
74         (adjoin-set (make-leaf (car pair)
75                                (cadr pair))
76                     (make-leaf-set (cdr pairs))))))
77
78 ;; (provide element-of-set? adjoin-set intersection-set)