symbolic differentiation system

diff --git a/src/sicp/ch2_3_deriv.rkt b/src/sicp/ch2_3_deriv.rkt
new file mode 100644 (file)
index 0000000..65a19ad
--- /dev/null
+++ b/src/sicp/ch2_3_deriv.rkt
@@ -0,0 +1,52 @@
+#lang racket
+
+(define (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 (multiplicant exp) var))
+                                  (make-product (multiplicant exp)
+                                                (deriv (multiplier exp) var))))
+        (else (error "unknown type of expression - deriv" exp))))
+
+(define (variable? x) (symbol? x))
+
+(define (same-variable? x y)
+  (and (variable? x) (variable? y) (eq? x y)))
+
+;; sum
+(define (make-sum x y) 
+  (cond ((equal? x 0) y)
+        ((equal? y 0) x)
+        ((and (number? x) (number? y)) (+ x y))
+        ((equal? x y) (make-product 2 x))
+        (else (list '+ x y))))
+
+(define (make-product x y) 
+  (cond ((equal? x 1) y)
+        ((equal? y 1) x)
+        ((equal? x 0) 0)
+        ((equal? y 0) 0)
+        (else (list '* x y))))
+
+(define (sum? exp) 
+  (and (pair? exp) 
+       (eq? (car exp) '+)))
+
+(define (product? exp)
+  (and (pair? exp)
+       (eq? (car exp) '*)))
+
+(define (addend exp) (car (cdr exp)))
+(define (augend exp) (car (cdr (cdr exp))))
+
+(define (multiplicant exp) (car (cdr exp)))
+(define (multiplier exp) (car (cdr (cdr exp))))
+
+
+;; tests
+(deriv '(+ x 3) 'x)
+(deriv '(* x y) 'x)
+(deriv '(* (* x y) (+ x 3)) 'x)
\ No newline at end of file