]> git.rkrishnan.org Git - sicp.git/blob - src/sicp/ex2_57.clj
rewrite `quote->cons' using `match'.
[sicp.git] / src / sicp / ex2_57.clj
1 (ns sicp.ex2_57
2   (:use [clojure.test]
3         [sicp.utils]))
4
5 (defn exponentiation? [exp]
6   (= (first exp) '**))
7
8 (defn base [exp]
9   (second exp))
10
11 (defn exponent [exp]
12   (second (rest exp)))
13
14 (defn variable? [x]
15   (symbol? x))
16
17 (defn same-variable? [v1 v2]
18   (and (variable? v1)
19        (variable? v2)
20        (= v1 v2)))
21
22 (defn =number? [exp num]
23   (and (number? exp) (= exp num)))
24
25 (defn make-sum [a1 a2]
26   (cond (=number? a1 0) a2
27         (=number? a2 0) a1
28         (and (number? a1) (number? a2)) (+ a1 a2)
29         :else (list '+ a1 a2)))
30
31 (defn make-product [m1 m2]
32   (cond (or (=number? m1 0) (=number? m2 0)) 0
33         (=number? m1 1) m2
34         (=number? m2 1) m1
35         (and (number? m1) (number? m2)) (* m1 m2)
36         :else (list '* m1 m2)))
37
38 (defn sum? [x]
39   (and (list? x) (= (first x) '+)))
40
41 (defn addend [s]
42   (second s))
43
44 (defn augend [s]
45   (reduce make-sum 0 (rest (rest s))))
46
47 (defn product? [x]
48   (and (list? x) (= (first x) '*)))
49
50 (defn multiplier [p]
51   (second p))
52
53 (defn multiplicand [p]
54   (reduce make-product 1 (rest (rest p))))
55
56 (defn make-exponentiation [b n]
57   (cond (=number? b 1) 1
58         (=number? b 0) 0        
59         (=number? n 1) b
60         (=number? n 0) 1
61         (and (number? b) (number? n)) (Math/pow b n)
62         :else (list '** b n)))
63
64 (defn deriv [exp var]
65   (cond (number? exp) 0
66         (variable? exp) (if (same-variable? exp var) 1 0)
67         (sum? exp) (make-sum (deriv (addend exp) var)
68                              (deriv (augend exp) var))
69         (product? exp) (make-sum (make-product (multiplier exp)
70                                                (deriv (multiplicand exp) var))
71                                  (make-product (deriv (multiplier exp) var)
72                                                (multiplicand exp)))
73         (exponentiation? exp) (make-product (exponent exp)
74                                             (make-product (make-exponentiation (base exp)
75                                                                                (- (exponent exp) 1))
76                                                           (deriv (base exp) var)))
77         :else (str "unknown expression type -- derive " exp)))