sicp-ex-2.73

Few notes.

The complex number example did not require that we call generic functions from inside the package. The package versions of deriv did require this because we needed to find the deriv of the data members (which could be any type of expression) in order to compute the answer.

The example package exported the data tagging to a func called tag outside of the internal package constructor. Did not do that in my packages because I needed to use the internal constructor in the internal deriv function.

Lastly, I assumed that the power in my exponential implementation was not the variable passed to deriv. This book is difficult enough already boyz, no need to deal with the chain rule.

  
 (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)))) 
  
 ;; A. Above we have exported the type dispatch from the cond block internal to the function to the assumed operation table. 
 ;; We do not dispatch to the operation table for numbers or variables because both are untagged. I suppose we could tag them but that would be a drag/why? 
  
 ;; B. 
  
 (define (install-sum-package) 
   (define (addend s) 
     (cadr s)) 
   (define (augend s) 
     (caddr s)) 
   (define (deriv-sum s var) 
     (make-sum (deriv (addend s) var);; deriv must be defined before this 
               (deriv (augend s) var))) 
   (define (make-sum x y) 
     (list '+ x y)) 
  
   ;; interface to the rest of the system 
   (put 'deriv  '(+) deriv-sum) 
   (put 'make-sum '+ make-sum) 
   'done) ;; I guess this is just here for a print out message... 
  
 (define (make-sum add aug) 
   ((get 'make-sum '+) add aug)) 
  
  
 (define (install-product-package) 
   (define (multiplier p) 
     (cadr p)) 
   (define (multiplicand p) 
     (caddr p)) 
   (define (deriv-product p) 
     (make-sum 
      (make-product (deriv (multiplier p)) 
                    (multiplicand p)) 
      (make-product (multiplier p) 
                    (deriv (multiplicand p))))) 
   (define (make-product x y) 
     (list '* x y)) 
  
   ;; interface to the rest of the system 
   (put 'deriv '(*) deriv-product) 
   (put 'make-product '* make-product) 
   'done) 
  
 ;; C. Going to assume that exponent is not a func(var) as I do not feel like dealing with the chain rule... like I really do not feel like dealing with that 
 (define (make-exponent-package) 
   (define (base expression) 
     (cadr expression)) 
   (define (power expression) 
     (caddr expression)) 
   (define (deriv-exponent expression) 
     (cond 
       ((= (power expression) 0) 0) 
       ((= (power expression) 1) (base expression)) 
       (else 
        (make-product 
         (power expression) 
         (make-exponent (base expression) 
                        (- (power expression) 1)))))) 
   (define (make-exponent base power) 
     (list 'expt base power)) 
  
   ;; interface to the rest of the system 
   (put 'deriv '(expt) deriv-exponent) 
   (put 'make-exponent 'expt make-exponent) 
   'done) 
  
 ;; D. Assuming that derivative system means the deriv generic function 
  
 (define (deriv exp var) 
   (cond ((number? exp) 0) 
         ((variable? exp) (if (same-variable? exp var) 1 0)) 
         ;; line below swaps the position of the first and second arguments in the get func 
         (else ((get (operator exp) 'deriv) (operands exp) 
                                            var)))) 
 ;; We would also have to swap the order of arguments to the put calls in the package installation functions

Here is my solution which can be tested in DrRacket.

  
 #lang racket 
 (define *the-table* (make-hash));make THE table 
 (define (put key1 key2 value) (hash-set! *the-table* (list key1 key2) value));put 
 (define (get key1 key2) (hash-ref *the-table* (list key1 key2) #f));get 
  
 (define (install-symbolic-differentiation-package) 
    
   (define (addend s) (car s)) 
  
   (define (augend s) 
     (let ((cs (cdr s))) 
       (if (null? (cdr cs)) 
           (car cs) 
           (cons '+ cs)))) 
    
   (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)))) 
    
   (put 'deriv '+ (lambda (operands var) 
                    (make-sum (deriv (addend operands) var) 
                               (deriv (augend operands) var)))) 
  
   (define (multiplier p) (car p)) 
   
   (define (multiplicand p) 
     (let ((cs (cdr p))) 
       (if (null? (cdr cs)) 
           (car cs) 
           (cons '* cs)))) 
  
   (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)))) 
    
   (put 'deriv '* (lambda (operands var) 
                    (make-sum 
                     (make-product  
                      (multiplier operands) 
                      (deriv (multiplicand operands) var)) 
                     (make-product  
                      (deriv (multiplier operands) var) 
                      (multiplicand operands))))) 
    
   (define base car) 
   (define exponent cadr) 
    
   (define (make-exponentiation base exponent) 
     (cond ((=number? base 0) 0) 
           ((=number? exponent 1) base) 
           ((=number? exponent 0) 1) 
           ((and (number? base) (number? exponent))  
            (expt base exponent)) 
           (else (list '** base exponent)))) 
    
   (put 'deriv '** (lambda (operands var) 
                    (make-product (exponent operands) 
                                  (make-product (make-exponentiation (base operands) 
                                                                     (- (exponent operands) 1)) 
                                                (deriv (base operands) var))))) 
    
   'done) 
  
 (define (variable? x) (symbol? x)) 
  
 (define (same-variable? v1 v2) 
   (and (variable? v1) 
        (variable? v2) 
        (eq? v1 v2))) 
  
 (define (=number? exp num) 
   (and (number? exp) (= exp num))) 
  
 (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)) 
  
 (install-symbolic-differentiation-package) 
 (deriv '(+ x x x) 'x) 
 (deriv '(* x x x) 'x) 
 (deriv '(+ x (* x  (+ x (+ y 2)))) 'x) 
 (deriv '(** x 3) '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))

a0_0x

I'd like code can run. Below is my codes. Seperated my codes into 3 files, run 2_73.scm to test the code

 ==> 2_73_b.scm <== 
 (define (install-sum-package) 
  (define (addend s) (car s)) 
  (define (augend s) (cadr s)) 
  (define (make-sum a b) 
   (cond 
    ((eq? a 0) b) 
    ((eq? b 0) a) 
    ((and (number? a) (number? b)) (+ a b)) 
    (else (list '+ a b)) 
   ) 
  ) 
  (define (deriv-sum s v) 
   (make-sum (deriv (addend s) v) (deriv (augend s) v)) 
  ) 
  (put 'deriv '+ deriv-sum) 
 'done) 
 (define (install-product-package) 
  (define (multiplier s) (car s)) 
  (define (multiplicand s) (cadr s)) 
  (define (make-product a b) 
   (cond 
    ((or (eq? a 0) (eq? b 0)) 0) 
    ((eq? a 1) b) 
    ((eq? b 1) a) 
    ((and (number? a) (number? b)) (* a b)) 
    (else '(* a b)) 
   ) 
  ) 
  (define (make-sum a b) 
   (cond 
    ((eq? a 0) b) 
    ((eq? b 0) a) 
    ((and (number? a) (number? b)) (+ a b)) 
    (else (list '+ a b)) 
   ) 
  ) 
  (define (deriv-product s v) 
   (make-sum 
    (make-product (deriv (multiplier s) v) (multiplicand s) ) 
    (make-product (multiplier s) (deriv (multiplicand s) v)) 
   ) 
  ) 
  (put 'deriv '* deriv-product) 
 'done) 
  
 ==> 2_73.scm <== 
 (load "2_73_sys.scm") 
 (define (variable? x) (symbol? x)) 
 (define (same-variable? x y) (and (variable? x) (variable? y) (eq? x y))) 
 (define (apply-generic op . args) 
  (let ((type-tags (map type-tag args))) 
   (let ((proc (get op type-tags))) 
    (if proc 
     (apply proc (map contents args)) 
     (error "No method for these types -- APPLY-GENERIC" 
      (list op type-tags) 
     ) 
    ) 
   ) 
  ) 
 ) 
 (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)) 
                 ;test 
 (load "2_73_b.scm") 
 (install-sum-package) 
 (install-product-package) 
 (deriv 'y 'x) 
 table 
 (get 'deriv '+) 
 (deriv '(+ (* x 3) (* y x)) 'x) 
 (deriv '(* 3 x) 'x) 
  
 ==> 2_73_sys.scm <== 
 (define table (list )) 
 (define (put op type proc) 
  (set! table (append table (list (list op type proc)))) 
  ) 
 (define (get op type) 
  (define (search op type t) 
   (cond ((null? t) #f) 
    ((and (eqv? (caar t) op) (eqv? (cadar t) type)) 
         (caddar t) 
    ) 
    (else (search op type (cdr t))) 
   ) 
  ) 
  (search op type table) 
  ) 
 (define (attach-tag type-tag contents) 
  (cons type-tag contents) 
  ) 
 (define (type-tag datum) 
  (if (pair? datum) 
   (car datum) 
   (error "Bad tagged datum -- TYPE-TAG" datum) 
  ) 
  ) 
 (define (content datum) 
  (if (pair? datum) 
   (cdr datum) 
   (error "Bad tagged datum -- CONTENTS" datum) 
  ) 
  ) 
 ;(install-sum-package) 
 ;(install-product-package) 
 ;table

masquue

I have found a deadly bug in almost every answer posted here before. It's about name conflict. For example in sum-package, in function deriv-sum, we are going to use make-sum again to producing the derivative. This make-sum, which we may intended to refer to the outer global make-sum defined by extracting from the table, is actually referring the inner local make-sum. This leads to the result derivative no longer a valid expression, which is just a pair without the type-tag. And the same problem appears in other packages too. My solution is to change the inner make-sum to make-sum-inner to avoid name conflict. Then we only have to change the make-sum to make-sum-inner in the (put 'make-sum '+ ...) and the program becomes correct. And I wonder if there are better solutions...

jirf

I noticed this as well. There should be no problem if we tag the return value of make-<expression type> in the body of the package version. We did that in 2.3.2 so if you just copy and paste make-<expression type> over from your old code you should be good.

tiendo1011

@masquue We don't need tag here.

To find the operation to applied, we need to know the operation & the type.

Here the operation is the deriv, and the type is the operator (+/*), which is easily extracted from the exp.

For the complex package example, the operation is provided, but the type is not, and there is no easy way to find the type of a complex number (hence the need to use tag).

tch

if your environment do not have a built-in put and get(like #lang sicp in Racket), just see Section 3.3.

 (define (make-table) (list '*table*)) 
 ; 2d table 
 (define (lookup2 key-1 key-2 table) 
     (let ((subtable (assoc key-1 (cdr table)))) 
         (if subtable 
             (let ((record (assoc key-2 (cdr subtable)))) 
                 (if record 
                     (cdr record) 
                     #f 
                 ) 
             ) 
             #f 
         ) 
     ) 
 ) 
 (define (insert2! key-1 key-2 value table) 
     (let ((subtable (assoc key-1 (cdr table)))) 
         (if subtable 
             ; subtable exist 
             (let ((record (assoc key-2 (cdr subtable)))) 
                 (if record 
                     (set-cdr! record value) ; modify record 
                     (set-cdr! subtable 
                               (cons (cons key-2 value) (cdr subtable))) ; add record 
                 ) 
             ) 
             ; subtable doesn't exist, insert a subtable 
             (set-cdr! table 
                       (cons (list key-1 (cons key-2 value)) ; inner subtable 
                             (cdr table)) 
             ) 
         ) 
     ) 
 ) 
  
 ; put and get 
 (define *table* (make-table)) ; a global table 
 (define (put op type item) 
     (insert2! op type item *table*) 
 ) 
 (define (get op type) 
     (lookup2 op type *table*) 
 )

tejomay

I went ahead and dispatched `make` on expression type as well. This resolves the naming conflicts noted above.

This solution will work for MIT scheme using custom `put` and `get` defined here: https://stackoverflow.com/a/29465496

 (define (test x y) (begin (display x) (if (not (equal? x y)) (error "fail") 'pass))) 
 (restart 1) 
 ; Helper 
 (define get 2d-get) 
 (define put 2d-put!) 
 ; #################### Expr #################### 
 ; Sel 
 (define (operator expr) (car expr)) 
 (define (operands expr) (cdr expr)) 
 (define (operand1 operands) (car operands)) 
 (define (operand2 operands) (cadr operands)) 
 ; Pred  
 (define (variable? expr) (symbol? expr)) 
 (define (same-variable? expr1 expr2)  
   (and (variable? expr1) (variable? expr2) (eq? expr1 expr2))) 
 (define (=number? expr num) (and (number? expr) (= expr num))) 
 ; #################### Deriv #################### 
 ; Proc 
 (define (make operator expr1 expr2) 
   ((get 'make operator) expr1 expr2)) 
 (define (deriv expr var) 
    (cond ((number? expr) 0) 
          ((variable? expr) (if (same-variable? expr var) 1 0)) 
          (else ((get 'deriv (operator expr)) (operands expr) 
                                             var)))) 
 ; #################### Dispatch #################### 
 (define (install-+) 
   (put 'make '+ 
        (lambda (expr1 expr2) 
          (cond ((=number? expr1 0) expr2) 
                ((=number? expr2 0) expr1) 
                ((and (number? expr1) (number? expr2)) (+ expr1 expr2)) 
                (else (list '+ expr1 expr2))))) 
   (put 'deriv '+ 
        (lambda (expr var) 
          (make '+ (deriv (operand1 expr) var) 
                   (deriv (operand2 expr) var)))) 
   'done) 
 (define (install-*) 
   (put 'make '* 
        (lambda (expr1 expr2) 
          (cond ((or (=number? expr1 0) (=number? expr2 0)) 0) 
                ((=number? expr1 1) expr2) 
                ((=number? expr2 1) expr1) 
                ((and (number? expr1) (number? expr2)) (* expr1 expr2)) 
                (else (list '* expr1 expr2))))) 
   (put 'deriv '* 
        (lambda (expr var) 
          (make '+ 
            (make '* (operand1 expr) (deriv (operand2 expr) var)) 
            (make '* (operand2 expr) (deriv (operand1 expr) var))))) 
   'done) 
 (define (install-**) 
   (put 'make '** 
        (lambda (expr1 expr2) 
          (cond ((=number? expr2 0) 1) 
                ((=number? expr2 1) expr1) 
                ((and (number? expr1) (number? expr2)) (expt expr1 expr2)) 
                (else (list '** expr1 expr2))))) 
   (put 'deriv '** 
        (lambda (expr var) 
          (make '* (make '* (operand2 expr) 
                            (make '** (operand1 expr) 
                                      (make '+ (operand2 expr) -1))) 
                   (deriv (operand1 expr) var)))) 
   'done) 
 ; Install 
 (install-+) 
 (install-*) 
 (install-**) 
 ; #################### Test #################### 
 (test (deriv '0 'x) 0) 
 (test (deriv 'x 'x) 1) 
 (define e1 (make '+ 'x 'y)) 
 (define e2 (make '* 'x 'y)) 
 (define e3 (make '+ 'x 3)) 
 (define e4 (make '* 3 'x)) 
 (define e5 (make '** 'x 3)) 
 (define e6 (make '** 'x e1)) 
 (define b1 (make '+ 'x (make '** 'x 2))) 
 (define e7 (make '** b1 3)) 
 (define e8 (make '** 'x (make '+ 'x 'y))) 
 (test (deriv e1 'x) 1) 
 (test (deriv e2 'x) 'y) 
 (test (deriv (make '+ e1 e2) 'x) (list '+ 1 'y)) 
 (test (deriv (make '* e1 e2) 'x) (list '+ (list '* e1 'y) e2)) 
 (test (deriv e5 'x) (list '* 3 (list '** 'x 2))) 
 (test (deriv e6 'x) (list '* e1 (list '** 'x (list '+ (list '+ 'x 'y) -1))))

Ergomaniac

Mass confusion and chaos! Granted, this is a difficult problem. Below are some thoughts that should ease confusion:

The only correct solution above is by Brave One. All others are fundamentally confused.

Some had the interesting idea to create a generic make function (see tejomay's solution). While a reasonable thought, it's not useful for our immediate needs. To illustrate, compare the default (make-sum 'x 'y) and tejomay's (make '+ 'x 'y)). No better, right? However, this could be useful in theory: imagine you're a procedure with an operator and some operands in hand, and you want to glue them together to create an expression. With the defaults, you must do something like:
```
(cond ((eq? operator '+) (make-sum operand1 operand2))
      ((eq? operator '*) (make-product operand1 operand2)))
      ((eq? operator '**) (make-exponent operand1 operand2)))
      ...
```
This has all the issues of dispatch-by-type as described in the last section. With a generic make, you instead do:
```
(make operator operand1 operand2)
```
Problem solved! (Note: still, this is only a hypothetical scenario, and even so I'm not convinced this is a good idea or whether this scenario is likely/possible. This is just an illustration for the sake of completeness.)

It does not make sense to define the constructors/selectors for the expression types like sum and product internally to the deriv packages for data dispatch, because then they're rendered inaccessible to users at the top level who want to build expressions and take derivatives of them. Many solutions made this error. To illustrate, user BE did this, and then was forced to pass quoted lists, e.g.
```
(deriv '(+ x x x) 'x) 
```
...but this violates data abstraction. If one day you decide to change the representation of sums - POOF! - this code is now broken. The lesson here is that "algebraic expression" is a higher-level concept than "derivative" (because derivatives require the existence of expressions, but the reverse is not true), and so the function scoping of each should reflect that.

Minor point: note that the starter code snippet passes arguments <operands> and <var> to the dispacthed 'deriv procedure, not <expr> and <var>. I think this is an odd choice because it cuts you off from using all existing the selectors defined on expressions like addend, etc. My only guess for their rationale is that they wanted to discard the operator since it's redundant information.