From: Ramakrishnan Muthukrishnan <vu3rdd@gmail.com>
Date: Wed, 24 Nov 2010 12:09:23 +0000 (+0530)
Subject: solution to 2.56
X-Git-Url: https://git.rkrishnan.org/components/com_hotproperty/%22doc.html/index.php?a=commitdiff_plain;h=926775e91cb255ab4f4c966a21d6b044aee7e89e;p=sicp.git

solution to 2.56
---

diff --git a/src/sicp/ex2_56.rkt b/src/sicp/ex2_56.rkt
new file mode 100644
index 0000000..57ffb3d
--- /dev/null
+++ b/src/sicp/ex2_56.rkt
@@ -0,0 +1,61 @@
+#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))))
+        ((exponentiation? exp) (let ((u (base exp))
+                                     (n (exponent exp)))
+                                 (make-product n
+                                               (make-product (make-exponentiation u (make-sum n -1))
+                                                             (deriv u 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))))
+
+;; exponentiation
+(define (exponentiation? exp) (eq? (car exp) '**))
+(define (base exp) (car (cdr exp)))
+(define (exponent exp) (car (cdr (cdr exp))))
+(define (make-exponentiation base exp) 
+  (cond ((and (number? exp) (zero? exp)) 1)
+        ((and (number? exp) (= exp 1)) base)
+        (else (list '** base exp))))
+