From: Ramakrishnan Muthukrishnan Date: Wed, 24 Nov 2010 12:10:01 +0000 (+0530) Subject: solution to 2.57. There has to be a more elegant solution X-Git-Url: https://git.rkrishnan.org/components/com_hotproperty/flags/%22doc.html/-?a=commitdiff_plain;h=17412e56336f0024c85f16b0964ddaa52b229c1d;p=sicp.git solution to 2.57. There has to be a more elegant solution --- diff --git a/src/sicp/ex2_57.rkt b/src/sicp/ex2_57.rkt new file mode 100644 index 0000000..dd96323 --- /dev/null +++ b/src/sicp/ex2_57.rkt @@ -0,0 +1,70 @@ +#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) + (define (augend* e1 . en) + (cond ((null? en) e1) + (else (make-sum e1 (apply augend* (car en) (cdr en)))))) + (apply augend* (cdr (cdr exp)))) + +(define (multiplicant exp) (car (cdr exp))) + +(define (multiplier exp) + (define (multiplier* e1 . en) + (cond ((null? en) e1) + (else (make-product e1 (apply multiplier* (car en) (cdr en)))))) + (apply multiplier* (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))))