2 (:use [sicp.utils :only (error)]
3 [sicp.ex2_54 :only (equal?)]))
9 :else (memq item (rest x))))
13 ;; take it for granted the following primitives.
14 (declare variable? same-variable? sum? addend augend make-sum product? make-product multiplier multiplicand)
18 (variable? exp) (if (same-variable? exp var) 1 0)
19 (sum? exp) (make-sum (deriv (addend exp) var)
20 (deriv (augend exp) var))
21 (product? exp) (make-sum (make-product (multiplier exp)
22 (deriv (multiplicand exp) var))
23 (make-product (deriv (multiplier exp) var)
25 :else (error "unknown expression type -- derive")))
30 (defn same-variable? [v1 v2]
35 (defn =number? [exp num]
36 (and (number? exp) (= exp num)))
38 (defn make-sum [a1 a2]
39 (cond (=number? a1 0) a2
41 (and (number? a1) (number? a2)) (+ a1 a2)
42 :else (list '+ a1 a2)))
44 (defn make-product [m1 m2]
45 (cond (or (=number? m1 0) (=number? m2 0)) 0
48 (and (number? m1) (number? m2)) (* m1 m2)
49 :else (list '* m1 m2)))
52 (and (list? x) (= (first x) '+)))
61 (and (list? x) (= (first x) '*)))
66 (defn multiplicand [p]
70 (defn element-of-set? [x set]
71 (cond (empty? set) false
72 (equal? x (first set)) true
73 :else (element-of-set? x (rest set))))
75 ;; add an element to the set, if not already part of the set and return the set. If
76 ;; already part of the set, then return the set
77 (defn adjoin-set [x set]
78 (if (element-of-set? x set)
82 ;; intersection of two sets (i.e. elements of the set which are present in both the
84 (defn intersection-set [set1 set2]
85 (cond (or (empty? set1) (empty? set2)) ()
86 (element-of-set? (first set1) set2) (cons (first set1)
87 (intersection-set (rest set1) set2))
88 :else (intersection-set (rest set1) set2)))
91 ;;; sets as ordered list
92 (defn element-of-set? [x set]
93 (cond (empty? set) false
94 (= (first set) x) true
95 (< x (first set)) false
96 :else (element-of-set? x (rest set))))
98 (defn intersection-set [set1 set2]
99 (if (or (empty? set1) (empty? set2))
101 (let [x1 (first set1)
103 (cond (= x1 x2) (cons x1 (intersection-set (rest set1)
105 (< x1 x2) (intersection-set (rest set1) set2)
106 (< x2 x1) (intersection-set (rest set2) set1)))))
109 ;;; trees using lists
110 ;;; every node is a list of 3 elements: entry, left tree and right tree
114 (defn left-branch [tree]
117 (defn right-branch [tree]
118 (second (rest tree)))
120 (defn make-tree [entry left right]
121 (list entry left right))
123 (defn element-of-set? [x set]
124 (cond (empty? set) false
125 (= (entry set) x) true
126 (< x (entry set)) (element-of-set? x (left-branch set))
127 (> x (entry set)) (element-of-set? x (right-branch set))))
129 (defn adjoin-set [x set]
130 (cond (empty? set) (make-tree x '() '())
131 (= x (entry set)) set
132 (< x (entry set)) (make-tree (entry set)
133 (adjoin-set x (left-branch set))
135 (> x (entry set)) (make-tree (entry set)
137 (adjoin-set x (right-branch set)))))
141 (defn lookup [given-key set-of-records]
142 (cond (empty? set-of-records) false
143 (equal? given-key (key (first set-of-records))) (first set-of-records)
144 :else (lookup given-key (rest set-of-records))))