From: Ramakrishnan Muthukrishnan 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/pf/components/com_hotproperty/...?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