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". 

brave one

I don't see the need for tags inside - operation itself is enough - and separation of functions'.

 (load "deriv.scm") 
  
  
 (define (install-deriv-package) 
   ;; internal procedures 
   (define (deriv-sum pair var) ; pair as list 
     (match pair 
       [(list a b) ; a + b, yeah sorry do addend / augend 
        (make-sum (deriv a var) 
                  (deriv b var))])) 
   (define (deriv-product pair var) 
     (match pair 
       [(list a b) ; a * b 
        (make-sum (make-product a 
                                (deriv b var)) 
                  (make-product b 
                                (deriv a var)))])) 
   (define (deriv-exponentiation pair var) 
     (match pair 
       [(list a b) ; a ^ b 
        (make-product b 
                      (make-product 
                       (make-exponentiation a 
                                            (make-sum b -1)) 
                       (deriv a var)))])) 
   ;; interface to the rest of the system 
   (put 'deriv '+ deriv-sum) 
   (put 'deriv '* deriv-sum) 
   (put 'deriv '** deriv-exponentiation) 
   'done) 
  
 ; just copy as is 
 (define (deriv exp var) 
    (cond ((number? exp) 0) 
          ((variable? exp) (if (same-variable? exp var) 1 0)) 
          (else ((get 'deriv (operator exp)) (operands exp) 
                                             var)))) 
 (define (operator exp) (car exp)) 
 (define (operands exp) (cdr exp))