From: Ramakrishnan Muthukrishnan <vu3rdd@gmail.com>
Date: Wed, 24 Nov 2010 14:10:06 +0000 (+0530)
Subject: solution to 2.58 a and b. Need to test more.
X-Git-Url: https://git.rkrishnan.org/simplejson/components/cyclelanguage?a=commitdiff_plain;h=797c3bd1d7c035ac99dfb02f8be35b3685eec9eb;p=sicp.git

solution to 2.58 a and b. Need to test more.
---

diff --git a/src/sicp/ex2_58a.rkt b/src/sicp/ex2_58a.rkt
new file mode 100644
index 0000000..bcdd8cd
--- /dev/null
+++ b/src/sicp/ex2_58a.rkt
@@ -0,0 +1,50 @@
+#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 (cdr exp)) '+)))
+
+(define (product? exp)
+  (and (pair? exp)
+       (eq? (car (cdr exp)) '*)))
+
+(define (addend exp) (car exp))
+(define (augend exp) (car (cdr (cdr exp))))
+
+(define (multiplicant exp) (car exp))
+(define (multiplier exp) (car (cdr (cdr exp))))
+
+;; test
+(deriv '(x + (3 * (x + (y + 2)))) 'x)
+(deriv '(x + (3 * (x + (y + 2)))) 'y)
\ No newline at end of file
diff --git a/src/sicp/ex2_58b.rkt b/src/sicp/ex2_58b.rkt
new file mode 100644
index 0000000..007e555
--- /dev/null
+++ b/src/sicp/ex2_58b.rkt
@@ -0,0 +1,69 @@
+#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? (first-op exp) '+)))
+
+(define (product? exp)
+  (and (pair? exp)
+       (eq? (first-op exp) '*)))
+
+(define (addend exp) (car exp))
+
+(define (augend exp)
+  (let ((aug (cdr (cdr exp))))
+    (cond ((= 1 (length aug)) (car aug))
+          ((pair? (car aug))  (car aug))
+          (else aug))))
+
+(define (multiplicant exp) (car exp))
+
+(define (multiplier exp) 
+  (let ((mul (cdr (cdr exp))))
+    (cond ((= 1 (length mul)) (car mul))
+          ((pair? (car mul)) (car mul))
+          (else mul))))
+
+(define (first-op exp) (car (cdr exp)))
+(define (second-op exp) (car (cdr (cdr (cdr exp)))))
+
+;; test
+(deriv '(x + 3 * (x + (y + 2))) 'x)
+(deriv '(x + (3 * (x + (y + 2)))) 'x)
+(deriv '(x + 3 * (x + (y + 2))) 'y)
+(deriv '(x + (3 * (x + (y + 2)))) 'y)
+(deriv '(x + x) 'x)
+(deriv '(x + 2 * x + 2) 'x)
\ No newline at end of file