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