fixup

1 files changed, 92 insertions, 0 deletions

diff --git a/coding-exercises/2/56.rkt b/coding-exercises/2/56.rkt
new file mode 100644
index 0000000..7ca4c42
--- /dev/null
+++ b/coding-exercises/2/56.rkt
@@ -0,0 +1,92 @@
+#lang racket
+
+(define (variable? x) (symbol? x))
+(define (same-variable? x y) (and (variable? x) (variable? y) (eq? x y)))
+
+(define (=number? x num)
+  (and (number? x) (= x num)))
+(define (make-sum a1 a2)
+  (cond ((=number? a1 0) a2)
+        ((=number? a2 0) a1)
+        ((and (number? a1)
+              (number? a2)) (+ a1 a2))
+        (else (list '+ a1 a2))))
+(define (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))))
+(define (make-exponent e p)
+  (cond ((=number? p 0) 1)
+        ((=number? p 1) e)
+        (else (list '** e p))))
+
+(define (sum? x)
+  (and (pair? x) (eq? (car x) '+)))
+(define (addend s) (cadr s))
+(define (augend s) (caddr s))
+
+(define (product? x)
+  (and (pair? x) (eq? (car x) '*)))
+(define (multiplier p)
+  (cadr p))
+(define (multiplicand p)
+  (caddr p))
+
+(define (exponent? x)
+  (and (pair? x) (eq? (car x) '**)))
+(define (base expo)
+  (cadr expo))
+(define (exponent expo)
+  (caddr expo))
+
+(define e '(+ a b))
+(define v1 'a)
+(define v2 'b)
+(define m1 'a)
+(define m2 'b)
+(define a1 'a)
+(define a2 'b)
+
+(variable? e)
+(same-variable? v1 v2)
+(sum? e)
+(addend e)
+(augend e)
+(make-sum a1 a2)
+(product? e)
+(multiplier e)
+(multiplicand e)
+(make-product m1 m2)
+
+(define (deriv expr var)
+  (cond ((number? expr) 0)
+        ((variable? expr)
+         (if (same-variable? expr var) 1 0))
+        ((sum? expr)
+         (make-sum (deriv (addend expr) var)
+                   (deriv (augend expr) var)))
+        ((product? expr)
+         (make-sum
+            (make-product 
+              (multiplier expr)
+              (deriv (multiplicand expr) var))
+            (make-product 
+              (deriv (multiplier expr) var)
+              (multiplicand expr))))
+        ((exponent? expr)
+         (make-product
+           (deriv (base expr) var)
+           (make-product
+             (exponent expr)
+             (make-exponent (base expr) (- (exponent expr) 1)))))
+        (else
+          (error "unkown expression type -- DERIV" expr))))
+
+(deriv '(+ x 3) 'x)
+(deriv '(* x y) 'x)
+(deriv '(* (* x y) (+ x 3)) 'x)
+
+(deriv '(** (* 10 a) 3) 'a)
+(deriv '(** a 2) 'a)