sicp-ex-2.57



<< Previous exercise (2.56) | Index | Next exercise (2.58) >>


 (define (make-sum-list l) 
   (if (= (length l) 2) 
       (list '+ (car l) (cadr l)) 
       (make-sum (car l) (make-sum-list (cdr l))))) 
 (define (make-sum a1 a2) 
   (cond ((=number? a1 0) a2) 
         ((=number? a2 0) a1) 
         ((and (number? a1) (number? a2)) (+ a1 a2)) 
         (else (make-sum-list (list a1 a2))))) 
  
 (define (make-product-list l) 
   (if (= (length l) 2) 
       (list '* (car l) (cadr l)) 
       (make-product (car l) (make-product-list (cdr l))))) 
 (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 (make-product-list (list m1 m2))))) 
  
 (define (augend s) 
   (let ((a (cddr s))) 
     (if (= (length a) 1) 
         (car a) 
         (make-sum-list a)))) 
 (define (multiplicand p) 
   (let ((m (cddr p))) 
     (if (= (length m) 1) 
         (car m) 
         (make-product-list m)))) 
  
 ;; tests 
 (deriv '(* (* x y) (+ x 3)) 'x) 
 ;; (+ (* x y) (* y (+ x 3))) 
  
 (deriv '(* x y (+ x 3)) 'x) 
 ;; (+ (* x y) (* y (+ x 3))) 

NTeGrotenhuis

Extend the differentiation program to handle sums and products of arbitrary numbers of (two or more) terms. Then the last example above could be expressed as

(deriv '(* x y (+ x 3)) 'x)

Try to do this by changing only the representation for sums and products, without changing the deriv procedure at all. For example, the addend of a sum would be the first term, and the augend would be the sum of the rest of the terms.

See sicp-ex-2.56 for the differentiation program

All that must be done to solve this problem is to change augend and multiplicand so that they return the sum or product, respectively, of the remaining items in the list.

 (define (augend s)    
   (accumulate make-sum 0 (cddr s))) 
  
 (define (multiplicand p)  
   (accumulate make-product 1 (cddr  p))) 

This works because (accumulate is really awesome.

 (define (accumulate op initial sequence) 
   (if (null? sequence) 
       initial 
       (op (car sequence) 
           (accumulate op initial (cdr sequence))))) 

It recursively applies the make function to add up all the items in the list.

 (accumulate make-sum 0 (cddr s))

Is analogous to

 (accumulate +  0 (cddr s))

For symbolic data. We must use (cddr s)) to get the rest of the list begining with the 3rd item.


meteorgan

As is mentioned above. All that must be done is to change "augend" and "multiplicand". The above solution is interesting, it use "accumulate" to change the representation of sum and product into the former version. for example: (augend (+ x x x x)) is (+ x (+ x x)), (multiplicand (* x x x x)) is (* x (* x x)). But there is another solution. Here is my code:

 ;; if there is 4th item, make-sum 3rd item and 4th item 
 (define (augend expr) 
   (if (null? (cdddr expr)) 
         (caddr expr) 
         (make-sum (caddr expr) (cadddr expr)))) 
  
 ;; if there is 4th item, make-product 3rd item and 4th item 
 (define (multiplicand expr) 
   (let ((first (caddr expr)) 
         (rest (cdddr expr))) 
     (if (null? rest) 
         first 
         (make-product first (cadddr expr))))) 

AMS

I agree with meteorgan's comment about the use of accumulate. As awesome and simple as it is, it changes the representation away from what we are using. I too came up with similar implementations of "augend" and "multiplicand" with the following changes. Instead of using "make-sum" and "make-product" I simply cons the operator to the beginning of the list.

 (define (augend s) 
   (if (null? (cdddr s)) 
       (caddr s) 
       (cons '+ (cddr s)))) 
  
 (define (multiplicand p) 
   (if (null? (cdddr p)) 
       (caddr p) 
       (cons '* (cddr p)))) 
  
 ;; using lets might make it easier to understand 
 (define (augend s) 
   (let ((augend-element (cddr s))) 
     (if (null? (cdr augend-element)) 
         (car augend-element) 
         (cons '+ augend-element)))) 
  
 (define (multiplicand p) 
   (let ((multiplicand-element (cddr p))) 
     (if (null? (cdr multiplicand-element)) 
         (car multiplicand-element) 
         (cons '* multiplicand-element)))) 

AThird

Here's my attempt at this.

  
 (define (augend s)  
   (if (> (length s) 3) 
       (make-sum (addend (cdr s)) (augend (cdr s))) 
       (caddr s))) 
  
 (define (multiplicand p) 
   (if (> (length p) 3) 
       (make-product (multiplier (cdr p)) 
                     (multiplicand (cdr p))) 
       (caddr p))) 

Rptx

This code accomplishes the same results, but I added simplification to it.

  
 (define (make-sum . l) 
   (let ((lst (if (null? (cdr l)) (car l) l))) ;-> if it's a list inside a list, fix that. 
     (let ((an (map (lambda (x) (if (and (pair? x) (sum? x)) 
                                    (make-sum (cdr x)) 
                                    x)) lst))) ;-> this will reduce inner sums. 
       (let ((var-lst (filter (lambda (x) (not (number? x))) an)) ;-> make a list of variable 
             (total (accumulate + 0 (filter number? an)))) ;-> sum all the numbers 
         (cond ((null? var-lst) total)   ;-> if  there are no variables, than the sum is total 
               ((= total 0) (if (null? (cdr var-lst)) ;-> if total is zero, then return var-lst 
                                (car var-lst) ;-> if it has only one element return it 
                                (append (list '+) var-lst))) ;-> if it has more, then represent a 
               ;list of the type (+ elements of var-lst) 
               (else 
                (append (list '+)        ;-> else, just give a sum 
                        var-lst 
                        total))))))) 
  
 (define (augend e) 
   (make-sum (cddr e))) 
  
 ; and make-product would be the same. 
  
 (define (make-product . l) 
   (let ((lst (if (null? (cdr l)) (car l) l))) 
     (let ((pn (map (lambda (x) (if (and (pair? x) (product? x)) 
                                    (make-product (cdr x)) 
                                    x)) lst))) 
       (let ((var-lst (filter (lambda (x) (not (number? x))) pn)) 
             (prod (accumulate * 1 (filter number? pn)))) 
         (cond ((null? var-lst) prod) 
               ((= prod 1)  
                (if (null? (cdr var-lst)) 
                    (car var-lst) 
                    (append (list '*) var-lst))) 
               ((= prod 0) 0) 
               (else 
                (append (list '*) 
                        var-lst 
                        (list prod)))))))) 
  
 (define (multiplicand p) 
   (make-product (cddr p))) 

fubupc

I have an version will "flatten" nested sum. e.g.

from:

 (make-sum 'x 5 '(+ y 10) 'z) 

to:

 '(+ 15 x y z) 
 (define (make-sum . s) 
   (define (sum-iter num-sum symbols seq) 
     (if (null? seq) 
       (cond ((null? symbols) num-sum) 
             ((= num-sum 0) 
              (if (= 1 (length symbols)) 
                (car symbols) 
                (cons '+ symbols))) 
             (else (cons '+ (cons num-sum symbols)))) 
       (let ((next (car seq)) 
             (rest (cdr seq))) 
         (cond ((number? next) (sum-iter (+ num-sum next) symbols rest)) 
               ((and (pair? next) (sum? next)) (sum-iter num-sum symbols (append (cdr next) rest))) 
               (else (sum-iter num-sum (append symbols (list next)) rest)))))) 
   (sum-iter 0 '() s)) 

Genovia

this is my simple solutin, and this is definitely right.

 (define (augend s) 
   (if (> (length s) 3) 
       (cons '+ (cddr s)) 
       (caddr s))) 
  
 (define (multiplicand p) 
   (if (> (length p) 3) 
       (cons '* (cddr p)) 
       (caddr p))) 
  

Maanu

Both the solutions above with accumulators and cons symbols are concise and intuitive. In my primary solution, I in fact modified both of the constructor and selectors. But both parts of modifications are small and not difficult to understand.

 (define (pure_pair? l) 
   (and (pair? l)  
        (not (sum? l)) 
        (not (product? l)) 
        (not (exponentition? l)))) 
  
 (define (make-sum a1 a2)  
   (cond ((pure_pair? a2) 
          (make-sum a1 (make-sum (car a2) (cdr a2)))) 
         ((null? a2) a1)    ;-> only these two new conditions are added to original make-sum in order to work with list input 
         ((and (number? a1) (= a1 0)) a2) 
         ((and (number? a2) (= a2 0)) a1) 
         ((and (number? a1) (number? a2)) (+ a1 a2)) 
         (else (list '+ a1 a2)))) 
  
 (define (make-product m1 m2) 
   (cond ((pure_pair? m2) 
          (make-product m1 (make-product (car m2) (cdr m2)))) 
         ((null? m2) m1) ;-> only these two new conditions are added to original make-product in order to work with list input 
         ((and (number? m1) (number? m2)) (* m1 m2)) 
         ((and (number? m1) (= m1 1)) m2) 
         ((and (number? m1) (= m1 0)) 0) 
         ((and (number? m2) (= m2 1)) m1) 
         ((and (number? m2) (= m2 0)) 0) 
         (else (list '* m1 m2)))) 
  
 (define (augend s) (make-sum (caddr s) (cdddr s))) ;-> augend would be the sum of the rest of the terms 
 (define (multiplicand p) (make-product (caddr p) (cdddr p))) ;-> multiplicand would be the product of the rest of the terms 

In my second attempt, I realize that modifications only in selectors should be enough. I end up with new selectors as

 (define (augend s) 
   (define (process l) 
     (if (null? (cdr l)) 
         (car l) 
         (make-sum (car l) (process (cdr l))))) 
   (process (cddr s))) 
  
 (define (multiplicand p) 
   (define (process l) 
     (if (null? (cdr l)) 
         (car l) 
         (make-product (car l) (process (cdr l))))) 
   (process (cddr p))) 

When I was doing this, I gradually obtained a strong feeling that recursion should work in this case. I feel I should link the element of list with constructors (make-product / make-sum), together with recursive call of selector it-self (augend / multiplicand). However, I can not do it, because the selectors work with list starting with a sign (+/*). Therefore, an additional function (process) is required to get rid of the sign during recursion. It turns out at the end this method is exactly the same as what accumulate dose. This deepen my understanding that with a higher level abstraction (accumulate), we change our mind of thinking about the subjects at hands and dealing with the problem in a more straightforward way. I still need more practices to get to that level of thinking. This kind of feeling of enlightenment, is just the value of doing SICP.