<< Previous exercise (2.87) | Index | Next exercise (2.89) >>


 (define (negate x) (apply-generic 'negate x)) 
 ;; add into scheme-number package 
 (put 'negate 'scheme-number 
       (lambda (n) (tag (- n)))) 
 ;; add into rational package 
 (put 'negate 'rational 
      (lambda (rat) (make-rational (- (numer rat)) (denom rat)))) 
 ;; add into complex package 
 (put 'negate 'complex 
      (lambda (z) (make-from-real-imag (- (real-part z)) 
                                       (- (imag-part z))))) 
 ;; add into polynomial package 
 (define (negate-terms termlist) 
   (if (empty-termlist? termlist) 
         (let ((t (first-term termlist))) 
           (adjoin-term (make-term (order t) (negate (coeff t))) 
                        (negate-terms (rest-terms termlist)))))) 
 (put 'negate 'polynomial 
          (lambda (poly) (make-polynomial (variable poly) 
                                          (negate-terms (term-list poly))))) 
 (put 'sub '(polynomial polynomial) 
       (lambda (x y) (tag (add-poly x (negate y))))) 
 (define (negate-terms termlist) 
       (lambda (t)(make-term(order t) 
                            (- (coeff t)))) 
 ;; I got the same idea as hi-artem to use map procedure, however I think we need to use the generic negate for coeff as well 
 (define (negate-poly p) 
   (make-polynomial (variable p) 
                      (lambda (term) 
                          (order term) 
                          (negate (coeff term)))) 
                      (term-list p)))) 

I think hi-artem is wrong and meterogan is right. Because MAP only works on lists, it is impossible to achieve Abstract masking if MAP is used.However, there are also errors in meterogan's writing.It should look like this:

 ;; add into complex package 
 (put 'negate 'complex 
      (lambda (z) (make-from-real-imag (negate (real-part z)) 
                                       (negate (imag-part z))))) 
 (put 'sub '(polynomial polynomial) 
       (lambda (x y) (tag (add-poly x (contents (negate (tag y))))))) 


I didn't follow the book's suggestion and implemented the sub procedure by adding the terms of the first polynomial to the multiplication of all terms of the second by -1 or -1x^0.

 (define (sub-poly p1 p2) 
       (if (same-variable? (variable p1) (variable p2)) 
           (make-poly (variable p1) 
                      (add-terms (term-list p1) 
                                 (mul-term-by-all-terms (make-term 0 -1) 
                                                        (term-list p2)))) 
           (error "Polys not in same var -- SUB-POLY" 
                  (list p1 p2)))) 


Other solutions seems to forget to tag their constructors.

 ;; generic negation 
 (define (negate x) 
   (apply-generic 'negate x)) 
 ;; in scheme number package 
 (put 'negate 'scheme-number (lambda (x) (tag (- x)))) ; tag is optional here 
 ;; rat package 
 (put 'negate 'rational (lambda (x) (tag (make-rat (- (numer x)) (denom x))))) 
 ;; into rectangular 
 (put 'negate 'rectangular (lambda (x) 
                             (tag (make-from-real-imag  
                                    (- (real-part x)) (- (imag-part x)))))) 
 ;; into polar 
 (put 'negate 'polar (lambda (x) (tag (make-from-mag-ang 
                                        (mag x) (+ (ang x) 180))))) 
 ;; into complex 
 (put 'negate 'complex negate) ; double tag system 
 ;; into poly 
 (define (negate-terms L) 
   (if (empty-termlist? L) the-empty-term-list ; what a stupid name, why "the"? 
     (let ((t1 (first-term L))) 
       (let ((negated-t1  
               (make-term (order t1) (negate (coeff t1))))) 
         (adjoin-term negated-t1 
                      (negate-terms (rest L))))))) 
 ;; Silly, but fun alternative. I'm assuming we can always multiply by minus-one 
 (define (negate-terms poly) 
   (let ((minus-one (make-term 0 -1))) 
   (make-polynomial (var poly) 
                    (mul-term-by-all-terms minus-one (terms poly))))) 
 (define (negate-poly poly) 
   (make-poly (var poly) 
              (negat-terms (terms poly)))) 
 (put 'negate 'polynomial (lambda (x) (tag (negate-poly x)))) 
 ;; generic sub in terms of negate and add 
 (define (sub x y) 
   (apply-generic 'add x (negate y)))  
 ;; We can subtract polynomials now :D 


Can't we just copy the strategy used in add-terms? Subtraction of polynomials boils down to subtraction of its coefficients, for which sub is defined on all types up to this point. Not that having a unary negation procedure isn't valuable, but it doesn't really seem strictly necessary in the context of the exercise. In the spirit of the book, we should really abstract out all the common code, but that's another issue.

 (define (sub-terms L1 L2) 
   (cond ((empty-termlist? L1) L2) 
         ((empty-termlist? L2) L1) 
          (let ((t1 (first-term L1)) 
                (t2 (first-term L2))) 
            (cond ((> (order t1) (order t2)) 
                    t1 (sub-terms (rest-terms t1) L2))) 
                  ((< (order t1) (order t2)) 
                    t2 (sub-terms L1 (rest-terms L2)))) 
                    (make-term (order t1) 
                               (sub (coeff t1) (coeff t2))) 
                    (sub-terms (rest-terms L1) 
                               (rest-terms L2)))))))))