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