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

This system can even do operations on different types of polynomials. `adjoin-term` is not perfect. It can't adjoin a term in the middle of a polynomial correctly. I will fix it later.

; these have to be added to the polynomial package. So now it dispatches to ; the generic procedures. (define (the-empty-termlist term-list) (let ((proc (get 'the-empty-termlist (type-tag term-list)))) (if proc (proc) (error "No proc found -- THE-EMPTY-TERMLIST" term-list)))) (define (rest-terms term-list) (let ((proc (get 'rest-terms (type-tag term-list)))) (if proc (proc term-list) (error "-- REST-TERMS" term-list)))) (define (empty-termlist? term-list) (let ((proc (get 'empty-termlist? (type-tag term-list)))) (if proc (proc term-list) (error "-- EMPTY-TERMLIST?" term-list)))) (define (make-term order coeff) (list order coeff)) (define (order term) (if (pair? term) (car term) (error "Term not pair -- ORDER" term))) (define (coeff term) (if (pair? term) (cadr term) (error "Term not pair -- COEFF" term))) ; here is the term-list package, which has the constructors and selectors for ; the dense and sparse polynomials. ; the generic first-term procedure. (define (first-term term-list) (let ((proc (get 'first-term (type-tag term-list)))) (if proc (proc term-list) (error "No first-term for this list -- FIRST-TERM" term-list)))) ; the pakcage with the constructors, selectors, and other helper procedures ; I had to implement. (define (install-polynomial-term-package) (define (first-term-dense term-list) (if (empty-termlist? term-list) '() (list (- (length (cdr term-list)) 1) (car (cdr term-list))))) (define (first-term-sparse term-list) (if (empty-termlist? term-list) '() (cadr term-list))) (define (prep-term-dense term) (if (null? term) '() (cdr term))) ;-> only the coeff for a dense term-list (define (prep-term-sparse term) (if (null? term) '() (list term))) ;-> (order coeff) for a sparse term-list (define (the-empty-termlist-dense) '(dense)) (define (the-empty-termlist-sparse) '(sparse)) (define (rest-terms term-list) (cons (type-tag term-list) (cddr term-list))) (define (empty-termlist? term-list) (if (pair? term-list) (>= 1 (length term-list)) (error "Term-list not pair -- EMPTY-TERMLIST?" term-list))) (define (make-polynomial-dense var terms) (make-polynomial var (cons 'dense (map cadr terms)))) (define (make-polynomial-sparse var terms) (make-polynomial var (cons 'sparse terms))) (put 'first-term 'sparse (lambda (term-list) (first-term-sparse term-list))) (put 'first-term 'dense (lambda (term-list) (first-term-dense term-list))) (put 'prep-term 'dense (lambda (term) (prep-term-dense term))) (put 'prep-term 'sparse (lambda (term) (prep-term-sparse term))) (put 'rest-terms 'dense (lambda (term-list) (rest-terms term-list))) (put 'rest-terms 'sparse (lambda (term-list) (rest-terms term-list))) (put 'empty-termlist? 'dense (lambda (term-list) (empty-termlist? term-list))) (put 'empty-termlist? 'sparse (lambda (term-list) (empty-termlist? term-list))) (put 'the-empty-termlist 'dense (lambda () (the-empty-termlist-dense))) (put 'the-empty-termlist 'sparse (lambda () (the-empty-termlist-sparse))) (put 'make-polynomial 'sparse (lambda (var terms) (make-polynomial-sparse var terms))) (put 'make-polynomial 'dense (lambda (var terms) (make-polynomial-dense var terms))) 'done) (install-polynomial-term-package) ; I had to changhe the adjoin-term procedure. It now does ; zero padding so we can `mul` dense polynomials correctly. (define (zero-pad x type) (if (eq? type 'sparse) '() (if (= x 0) '() (cons 0 (add-zeros (- x 1)))))) (define (adjoin-term term term-list) (let ((preped-term ((get 'prep-term (type-tag term-list)) term)) (preped-first-term ((get 'prep-term (type-tag term-list)) (first-term term-list)))) (cond ((=zero? (coeff term)) term-list) ((empty-termlist? term-list) (append (the-empty-termlist term-list) preped-term (zero-pad (order term) (type-tag term-list)))) ((> (order term) (order (first-term term-list))) (append (list (car term-list)) preped-term (zero-pad (- (- (order term) (order (first-term term-list))) 1) (type-tag term-list)) (cdr term-list))) (else (append preped-first-term (adjoin-term term (rest-terms term-list))))))) ; here is `negate` now it creates a polynomial of the correct ; type (define (negate p) (let ((neg-p ((get 'make-polynomial (type-tag (term-list p))) (variable p) (list (make-term 0 -1))))) (mul-poly (cdr neg-p) p)))

My solution is perhaps not as complete overall but I feel it is closer to what the authors would have expected since its approach is copied from section 2.4.3.

(define (install-polynomial-dense-package) (define (adjoin-term term term-list) (if (= (order term) (length term-list)) (cons (coeff term) term-list) (adjoin-term term (cons 0 term-list)))) (define (first-term term-list) (make-term (car term-list) (- (length term-list) 1))) ; here place all the other procedures (define (tag x) (attach-tag 'polynomial-dense x)) (put 'adjoin-term 'polynomial-dense (lambda (term term-list) (tag (adjoin-term term term-list)))) (put 'first-term 'polynomial-dense (lambda (term-list) (tag (first-term term-list)))) ; here place all the other calls to put 'done) (define (install-polynomial-sparse-package) (define (adjoin-term term term-list) (if (=zero? (coeff term)) term-list (cons term term-list))) (define (first-term term-list) (car term-list)) ; here place all the other procedures (define (tag x) (attach-tag 'polynomial-sparse x)) (put 'adjoin-term 'polynomial-sparse (lambda (term term-list) (tag (adjoin-term term term-list)))) (put 'first-term 'polynomial-sparse (lambda (term-list) (tag (first-term term-list)))) ; here place all the other calls to put 'done) ; ommitted repeated procedures -- they would be the same for both packages (define (make-poly variable term-list) (if (poly-sparse? term-list) ((get 'make-poly 'polynomial-sparse) term-list) ((get 'make-poly 'polynomial-dense) term-list))) (define (poly-sparse? term-list) ; a polynomial is sparse if at least half of its coefficients are zero (define (iter zeros remaining) (cond ((null? remaining) zeros) ((equ? (coeff (car remaining)) 0) (iter (+ zeros 1) (cdr remaining))) (else (iter zeros (cdr remaining))))) ; the above could also be done with reduce (> (iter 0 term-list) (/ (length term-list) 2)))

woofy