sicp-ex-2.73



<< Previous exercise (2.72) | Index | Next exercise (2.74) >>


 ;; ----------------------------------------------- 
 ;; EXERCISE 2.73 
 ;; ----------------------------------------------- 
  
 ;; b 
 (define (install-sum-package) 
   (define (make-sum a1 a2) (cons a1 a2)) 
   (define (addend s) (cadr s)) 
   (define (augend s) (caddr s)) 
   (define (deriv-sum s) 
     (make-sum (deriv (addend s)) (deriv (augend s)))) 
  
   (define (tag x) (attach-tag '+ x)) 
   (put 'deriv '(+) deriv-sum) 
   (put 'make-sum '+ 
        (lambda (x y) (tag (make-sum x y)))) 
   'done) 
  
 (define (make-sum x y) 
   ((get 'make-sum '+) x y)) 
  
 (define (install-product-package) 
   (define (make-product m1 m2) (cons m1 m2)) 
   (define (multiplier p) (cadr p)) 
   (define (multiplicand p) (caddr p)) 
   (define (deriv-product p) 
     (make-sum 
      (make-product (multiplier exp) 
                    (deriv (multiplicand exp) var)) 
      (make-product (deriv (multiplier exp) var) 
                    (multiplicand exp)))) 
  
   (define (tag x) (attach-tag '* x)) 
   (put 'deriv '(*) deriv-product) 
   (put 'make-product '* 
        (lambda (x y) (tag (make-product x y)))) 
   'done) 
  
 (define (make-product x y) 
   ((get 'make-product '*) x y)) 
  
 (define (deriv x) (apply-generic 'deriv x)) 

meteorgan

Here is my answer.

  
 ;;a 
 number?, same-variable? are predicates. there's nothing to dispatch. 
  
 ;; b 
 (define (install-sum-package) 
   (define (sum-deriv expr var) 
         (make-sum (deriv (addend expr) var) 
                   (deriv (augend expr) var))) 
   (define (addend expr) (car expr)) 
   (define (augend expr) (cadr expr)) 
   (define (make-sum x1 x2) 
         (cond ((and (number? x1) (number? x2)) (+ x1 x2)) 
               ((=number? x1 0) x2) 
               ((=number? x2 0) x1) 
               (else (list '+ x1 x2)))) 
  (define (mul-deriv expr var) 
    (make-sum (make-product (multiplier expr) 
                            (deriv (multiplicand expr) var)) 
              (make-product (multiplicand expr) 
                            (deriv (multiplier expr) var)))) 
  (define (multiplier expr) (car expr)) 
  (define (multiplicand expr) (cadr expr)) 
  (define (make-product x1 x2) 
    (cond ((and (number? x1) (number? x2)) (* x1 x2)) 
          ((=number? x1 1) x2) 
          ((=number? x2 1) x2) 
          ((or (=number? x1 0) (=number? x2 0)) 0) 
          (else (list '* x1 x2)))) 
  
  (put 'deriv '+ sum-deriv) 
  (put 'deriv '* mul-deriv)) 
  
  ;; c 
  (define (exponentation-deriv expr var) 
    (make-product (exponent expr) 
                  (make-product  
                    (make-exponentiation (base expr) 
                                         (make-sum (exponent expr) -1)) 
                    (deriv (base expr) var)))) 
  (define (exponent expr) 
    (cadr expr)) 
  (define (base expr) 
    (car expr)) 
  (define (make-exponentiation base exponent) 
    (cond ((=number? exponent 0) 1) 
          ((=number? exponent 1) base) 
          ((=number? base 1) 1) 
          (else (list '** base exponent)))) 
  
  (put 'deriv '** exponentiation-deriv) 
  
 ;;d 
 The only thing to do is changing the order of arguments in procedure "put".