sicp-ex-2.58



<< Previous exercise (2.57) | Index | Next exercise (2.59) >>


sgm

We’re only going to bother with part (b) here, because the solution for that is also a solution for part (a).

The main problem is essentially to recognize whether a given expression is a sum or product. Now, keep in mind that, despite our moving to a representation that is more orthodox to traditional notation, we are still playing a pun: the parentheses which in one sense are used as mathematical groupings are at the same time sub-lists in list-structure. We can assume that these sub-lists will be valid expressions, so they will also be self-contained expressions. The upshot of this is that we need to concern ourselves with only the topmost “layer” of an expression: '(x * y * (x + 3)) and '((x * y) + (x * y + z)) to give two examples, will look like '(x * y * ░░░) and '(░░░ + ░░░) as far as we’re concerned.

Now to tell what sort of expression we have, we need to find out what operator will be the last one applied to the terms should we attempt to evaluate the expression. This has to be the operator with the lowest precedence among all the visible ones. So the predicates sum? and product? will seach out the lowest-precedence operator and comprare it to '+ and '* respectively:

 (define (sum? expr) 
   (eq? '+ (smallest-op expr))) 
  
 (define (product? expr) 
   (eq? '* (smallest-op expr))) 

Where smallest-op searches an expression for the lowest-precedence operator, which can be done as an accumulation:

 (define (smallest-op expr) 
   (accumulate (lambda (a b) 
                 (if (operator? b) 
                     (min-precedence a b) 
                     a)) 
               'maxop 
               expr)) 

There’s a lot of wishful thinking going on here! Anyways, we need a predicate operator? which says if a symbol is a recognizable operator, min-precedence which is like min but over operator precedence instead of numbers, and a thing called 'maxop which is basically a dummy value that is always considered “greater than” any other operator.

 (define *precedence-table* 
   '( (maxop . 10000) 
      (minop . -10000) 
      (+ . 0) 
      (* . 1) )) 
  
 (define (operator? x) 
   (define (loop op-pair) 
     (cond ((null? op-pair) #f) 
           ((eq? x (caar op-pair)) #t) 
           (else (loop (cdr op-pair))))) 
   (loop *precedence-table*)) 
  
 (define (min-precedence a b) 
   (if (precedence<? a b) 
       a 
       b)) 
  
 (define (precedence<? a b) 
   (< (precedence a) (precedence b))) 
  
 (define (precedence op) 
   (define (loop op-pair) 
     (cond ((null? op-pair) 
            (error "Operator not defined -- PRECEDENCE:" op)) 
           ((eq? op (caar op-pair)) 
            (cdar op-pair)) 
           (else 
            (loop (cdr op-pair))))) 
   (loop *precedence-table*)) 

So there is this thing we call the *precedence-table* which is a list of pairs mapping operator symbols to values denoting their absolute precedence; the higher the number, the higher the precedence. operator? is a search of this car’s of the pairs, looking for a match. min-precedence orders two operators by the operator<? predicate, which tests if the precedence of the first operator is less than the second. precedence is a utility procedure to get the precedence value for an operator.¹

So we can now recognize sums and products and the dispatching part of deriv now works. Let’s now look at extracting their parts and making new ones. Given that expr is a list representing, say, a sum, then we can find the plus sign using memq. The augend of expr is the list of elements preceding the plus sign, and the addend the succeeding. Well, the augend is easy enough, it’s the cdr of the result of memq:

 (define (augend expr) 
   (let ((a (cdr (memq '+ expr)))) 
     (if (singleton? a) 
         (car a) 
         a))) 

N.B. The reason we test for a singleton (list of one element) and pull out the item is that otherwise deriv would be asked eventually to differentiate something like (1) or ('x), which it doesn’t know how to do.

But to get the addend, we basically have to rewrite memq, but to accumulate the things prior to symbol.

 (define (prefix sym list) 
   (if (or (null? list) (eq? sym (car list))) 
       '() 
       (cons (car list) (prefix sym (cdr list))))) 
  
 (define (addend expr) 
   (let ((a (prefix '+ expr))) 
     (if (singleton? a) 
         (car a) 
         a))) 

And now to make a sum, taking care of the standard numerical reductions:

 (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)))) 

And to finish things off, we’ll define the procedures for products, which are basically similar to the above.

 (define (multiplier expr) 
   (let ((m (prefix '* expr))) 
     (if (singleton? m) 
         (car m) 
         m))) 
  
 (define (multiplicand expr) 
   (let ((m (cdr (memq '* expr)))) 
     (if (singleton? m) 
         (car m) 
         m))) 
  
 (define (make-product m1 m2) 
   (cond ((=number? m1 1)  m2) 
         ((=number? m2 1)  m1) 
         ((or (=number? m1 0) (=number? m2 0))  0) 
         ((and (number? m1) (number? m2)) 
          (* m1 m2)) 
         (else (list m1 '* m2)))) 

Well, let’s take our new toy out for a test spin.

]=> (deriv '(x + 3 * (x + y + 2)) 'x)
;Value: 4

]=> (deriv '(x + 3) 'x)
;Value: 1

]=> (deriv '(x * y * (x + 3)) 'x)
;Value 88: ((x * y) + (y * (x + 3)))

;; Will extraneous parens throw our deriv for a loop?
]=> (deriv '((x * y) * (x + 3)) 'x)
;Value 89: ((x * y) + (y * (x + 3)))

]=> (deriv '(x * (y * (x + 3))) 'x)
;Value 90: ((x * y) + (y * (x + 3)))

¹ I’m exposing the structure of the table by writing caar and such, but I’m sick enough of writing procedures not to bother with the proper abstraction layers (P.S. the wiki’s Scheme highlighter doesn’t understand cdar).


AA

Part A is pretty straight forward, we will just change the representation of the date:

  
 (define (make-sum a1 a2) 
   (cond ((=number? a1 0) a2) 
         ((=number? a2 0) a1) 
         (else (list a1 '+ a2)))) 
  
 (define (sum? x) (and (pair? x) (eq? (cadr x) '+))) 
 (define (addend s) (car s)) 
 (define (augend s) (caddr s)) 
  
 (define (make-product m1 m2) 
   (cond ((=number? m1 1) m2) 
         ((=number? m2 1) m1) 
         ((or (=number? m1 0) (=number? m2 0)) 0) 
         (else (list m1 '* m2)))) 
  
 (define (product? x) (and (pair? x) (eq? (cadr x) '*))) 
 (define (multiplier x) (car x)) 
 (define (multiplicand x) (caddr x)) 

For part B, since we can't use cadr to get the augend or the multiplicand because they might be more than one item, so we have to use cddr, but the problem with cddr is that it always returns a list, so we're going to use a cleaning procedure.

  
 (define (cleaner sequence) 
   (if (null? (cdr sequence)) 
       (car sequence) 
       sequence)) 
  
  
 (define (augend x) 
   (cleaner (cddr x))) 
  
 (define (multiplicand x) 
   (cleaner (cddr x))) 

meteorgan

Here, we only think about sum expression and product expression. so if there is a '+ in the list, we think it's a sum expression, otherwise is a product expression. addend, multiplier is the part before '+, '* respectly in the list, augend, multiplicand is the part after '+, '* in the list. we only have to change predicates, selectors and constructors to solve the problem.

 (define (operation expr) 
   (if (memq '+ expr) 
       '+ 
       '*)) 
  
 (define (sum? expr) 
   (eq? '+ (operation expr))) 
 (define (addend expr) 
   (define (iter expr result) 
         (if (eq? (car expr) '+) 
           result 
           (iter (cdr expr) (append result (list (car expr)))))) 
   (let ((result (iter expr '()))) 
     (if (= (length result) 1) 
         (car result) 
         result))) 
 (define (augend expr) 
   (let ((result (cdr (memq '+ expr)))) 
     (if (= (length result) 1) 
         (car result) 
         result))) 
  
 (define (product? expr) 
   (eq? '* (operation expr))) 
 (define (multiplier expr) 
   (define (iter expr result) 
         (if (eq? (car expr) '*) 
           result 
           (iter (cdr expr) (append result (list (car expr)))))) 
   (let ((result (iter expr '()))) 
     (if (= (length result) 1) 
         (car result) 
         result))) 
 (define (multiplicand expr) 
   (let ((result (cdr (memq '* expr)))) 
     (if (= (length result) 1) 
         (car result) 
         result)))