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)))