symbolic differentiation section

diff --git a/src/sicp/ch2_3.clj b/src/sicp/ch2_3.clj
index 28df09496889d19b2a41dcc70cf950d7281f129f..b1eea97e4be7414f6eb4cadeff63399bc1da3188 100644 (file)
--- a/src/sicp/ch2_3.clj
+++ b/src/sicp/ch2_3.clj
@@ -1,7 +1,67 @@
-(ns sicp.ch2_3)
+(ns sicp.ch2_3
+  (:use [sicp.utils :only (error)]))
 
 (defn memq [item x]
   (cond
     (empty? x) false
     (= (first x) item) x
-    :else (memq item (rest x))))
\ No newline at end of file
+    :else (memq item (rest x))))
+
+;; differentiation
+
+;; take it for granted the following primitives.
+(declare variable? same-variable? sum? addend augend make-sum product? make-product multiplier multiplicand)
+
+(defn deriv [exp var]
+  (cond (number? exp) 0
+        (variable? exp) (if (same-variable? exp var) 1 0)
+        (sum? exp) (make-sum (deriv (addend exp) var)
+                             (deriv (augend exp) var))
+        (product? exp) (make-sum (make-product (multiplier exp)
+                                               (deriv (multiplicand exp) var))
+                                 (make-product (deriv (multiplier exp) var)
+                                               (multiplicand exp)))
+        :else (error "unknown expression type -- derive")))
+
+(defn variable? [x]
+  (symbol? x))
+
+(defn same-variable? [v1 v2]
+  (and (variable? v1)
+       (variable? v2)
+       (= v1 v2)))
+
+(defn =number? [exp num]
+  (and (number? exp) (= exp num)))
+
+(defn make-sum [a1 a2]
+  (cond (=number? a1 0) a2
+        (=number? a2 0) a1
+        (and (number? a1) (number? a2)) (+ a1 a2)
+        :else (list '+ a1 a2)))
+
+(defn make-product [m1 m2]
+  (cond (or (=number? m1 0) (=number? m2 0)) 0
+        (=number? m1 1) m2
+        (=number? m2 1) m1
+        (and (number? m1) (number? m2)) (* m1 m2)
+        :else (list '* m1 m2)))
+
+(defn sum? [x]
+  (and (list? x) (= (first x) '+)))
+
+(defn addend [s]
+  (second s))
+
+(defn augend [s]
+  (second (rest s)))
+
+(defn product? [x]
+  (and (list? x) (= (first x) '*)))
+
+(defn multiplier [p]
+  (second p))
+
+(defn multiplicand [p]
+  (second (rest p)))
+