SICP Exercise 2.89

Most procedures do not need any changes except make-poly, adjoin-term and first-term. We have added a new internal proceudre remove-leading-zeros to simplify polynomials. And we have also implemented the summation of a Scheme number and a polynomial.

; in install-polynomial-package
  (define (make-poly variable term-list)
    (cons variable (remove-leading-zeros term-list)))
  (define (remove-leading-zeros L)
    (cond ((null? L) '())
          ((=zero? (car L)) (remove-leading-zeros (cdr L)))
          (else L)))
  (define (adjoin-term term term-list)
    (cond ((=zero? (coeff term)) term-list)
          ((= (order term) (length term-list))
           (cons (coeff term) term-list))
          (else (adjoin-term term (cons 0 term-list)))))
  (define (first-term L)
    (make-term (- (length L) 1) (car L)))
  (define (add-num-poly x p)
    (make-poly (variable p)
               (add-x-to-list x (term-list p))))
  (define (add-x-to-list x L)
    (cond ((empty-termlist? L) (list x))
          ((null? (cdr L)) (list (+ x (car L))))
          (else (cons (car L) (add-x-to-list x (cdr L))))))

  (put 'add '(scheme-number polynomial)
       (lambda (x p) (tag (add-num-poly x p))))
  (put 'add '(polynomial scheme-number)
       (lambda (p x) (tag (add-num-poly x p))))

; tests
(install-scheme-number-package)
(install-polynomial-package)

(define ca (make-polynomial 'x '(2 3 1)))
(define cb (make-polynomial 'x '(4 0 1 0)))
(define cc (make-polynomial 'x '(1 10)))
(define cd (make-polynomial 'x '(-4 0 -1 0)))
(define ce (make-polynomial 'x '(5 0 0 0 0 3 0 0 0)))
(define p1 (make-polynomial 'y (list ca cb cc)))
(define p2 (make-polynomial 'y (list ca cb)))
(define p3 (make-polynomial 'y (list ca cd cc)))
(define p4 (make-polynomial
            'y (list cd
                     (make-polynomial 'x '())
                     (make-polynomial 'x '())
                     cc
                     (make-polynomial 'x '()))))

(add 2.5 ce)
;Value: (polynomial x 5 0 0 0 0 3 0 0 2.5)

(add cc 4)
;Value: (polynomial x 1 14)

(add ca cb)
;Value: (polynomial x 4 2 4 1)

(add cb cd)
;Value: (polynomial x)

(add ce ca)
;Value: (polynomial x 5 0 0 0 0 3 2 3 1)

(=zero? (add cb cd))
;Value: #t

(mul ca cc)
;Value: (polynomial x 2 23 31 10)

(mul ce cd)
;Value: (polynomial x -20 0 -5 0 0 -12 0 -3 0 0 0 0)

(add p1 p2)
;Value: (polynomial y (polynomial x 2 3 1)
;                     (polynomial x 4 2 4 1)
;                     (polynomial x 4 0 2 10))

(mul p2 p3)
;Value: (polynomial y (polynomial x 4 12 13 6 1)
;                     0
;                     (polynomial x -16 0 -8 2 22 31 10)
;                     (polynomial x 4 40 1 10 0))

(mul p1 p4)
;Value: (polynomial y (polynomial x -8 -12 -6 -3 -1 0)
;                     (polynomial x -16 0 -8 0 -1 0 0)
;                     (polynomial x -4 -40 -1 -10 0)
;                     (polynomial x 2 23 31 10)
;                     (polynomial x 4 40 1 10 0)
;                     (polynomial x 1 20 100)
;                     0)

(sub cb cd)
;Value: (polynomial x 8 0 2 0)

(sub p1 p2)
;Value: (polynomial y (polynomial x 2 3 1)
;                     (polynomial x 4 -2 -2 -1)
;                     (polynomial x -4 0 0 10))

(sub p1 p3)
;Value: (polynomial y (polynomial x 8 0 2 0) 0)

(sub p4 p2)
;Value: (polynomial y (polynomial x -4 0 -1 0) 0 0 (polynomial x -2 -2 9) (polynomial x -4 0 -1 0))