sicp-ex-2.90

  
  
 ; install different term-list representations correspondingly: 
  
 ; sparse as in the text 
 (define (install-dense-term-list) 
      
     ;inner 
     (define (adjoin-term term term-list) 
         (if (=zero? (coeff term)) 
             term-list  
             (cons (term term-list))))  
  
     (define (first-term term-list) (car term-list)) 
     (define (rest-terms term-list) (cdr term-list)) 
  
     ;interface 
     (define (tag term-list) (attach-tag 'sparse term-list)) 
  
     (put 'adjoin-term 'sparse adjoin-term)  
  
     (put 'first-term '(sparse)  
         (lambda (term-list) (first-term term-list))) 
  
     (put 'rest-term '(sparse)  
         (lambda (term-list) (tag (rest-terms term-list)))) 
     'done) 
  
 ; dense from ex_2.89 
 (define (install-dense-term-list) 
      
     ;inner 
     (define (adjoin-term term term-list)  
     (cond ((=zero? (coeff term)) term-list)  
             ((=equ? (order term) (length term-list)) (cons (coeff term) term-list))  
             (else (adjoin-term term (cons 0 term-list)))))  
  
     (define (first-term term-list) (make-term (- (length term-list) 1) (car term-list))) 
     (define (rest-terms term-list) (cdr term-list)) 
  
     ;interface 
     (define (tag term-list) (attach-tag 'dense term-list)) 
  
     (put 'adjoin-term 'dense adjoin-term)  
  
     (put 'first-term '(dense)  
         (lambda (term-list) (first-term term-list))) 
  
     (put 'rest-term '(dense)  
         (lambda (term-list) (tag (rest-terms term-list)))) 
     'done) 
  
 ; since term representation is all the same,  
 ; we only registered the term-list type into the table. 
 (define (adjoin-term term term-list)  
     ((get 'adjoin-term (type-tag term-list)) term term-list)) 
  
 (define (first-term term-list) (apply-generic 'first-term term-list)) 
 (define (rest-term term-list) (apply-generic 'rest-term term-list)) 

We only need to change how terms and term lists are represented. All terms are tagged "term", and all term lists are tagged "sparse" or "dense".

 (define (install-terms-package) 
   ;; internal procedures 
  
   ;; not changed 
   (define (the-empty-termlist) '()) 
   (define (rest-terms term-list) (cdr term-list)) 
   (define (empty-termlist? term-list) 
     (null? term-list)) 
   (define (make-term order coeff) 
     (list order coeff)) 
   (define (order term) (car term)) 
   (define (coeff term) (cadr term)) 
  
   ;; sparse representation 
   (define (adjoin-term-sparse term term-list) 
     (if (=zero? (coeff term)) 
         term-list 
         (cons term term-list))) 
   (define (first-term-sparse term-list) (car term-list)) 
   ;; dense representation, from Exercise 2.89 
   (define (first-term-dense term-list) 
     (make-term (- (length term-list) 1) 
                (car term-list))) 
   (define (adjoin-term-dense term term-list) 
     (cond ((=zero? (coeff term)) term-list) 
           ((= (order term) (length (term-list))) 
            (cons (coeff term) term-list)) 
           (else (adjoin-term-dense term (cons 0 term-list))))) 
  
   ;; interface to the rest of the system 
   (define (tag-sparse x) (attatch-tag 'sparse x)) 
   (define (tag-dense x) (attatch-tag 'dense x)) 
   (define (tag-term x) (attatch-tag 'term x)) 
   (put 'adjoin-term '(term sparse) 
        (lambda (term term-list) 
          (tag-sparse (adjoin-term-sparse term term-list)))) 
   (put 'adjoin-term '(term dense) 
        (lambda (term term-list) 
          (tag-dense (adjoin-term-dense term term-list)))) 
   (put 'the-empty-termlist 'sparse 
        (lambda () (tag-sparse (the-empty-termlist)))) 
   (put 'the-empty-termlist 'dense 
        (lambda () (tag-dense (the-empty-termlist)))) 
   (put 'first-term '(sparse) 
        (lambda (term-list) 
          (tag-term (first-term-sparse term-list)))) 
   (put 'first-term '(dense) 
        (lambda (term-list) 
          (tag-term (first-term-dense term-list)))) 
   (put 'rest-terms '(sparse) 
        (lambda (term-list) 
          (tag-sparse (rest-terms term-list)))) 
   (put 'rest-terms '(dense) 
        (lambda (term-list) 
          (tag-dense (rest-terms term-list)))) 
   (put 'empty-termlist? '(sparse) 
        (lambda (term-list) (empty-termlist? term-list))) 
   (put 'empty-termlist? '(dense) 
        (lambda (term-list) (empty-termlist? term-list))) 
   (put 'make-term 'term 
        (lambda (order coeff) 
          (tag-term (make-term order coeff)))) 
   (put 'order '(term) order) 
   (put 'coeff '(term) coeff) 
   'done) 
  
 (define (adjoin-term term term-list) 
   (apply-generic 'adjoin-term term term-list)) 
 (define (first-term term-list) 
   (apply-generic 'first-term term-list)) 
 (define (rest-terms term-list) 
   (apply-generic 'rest-terms term-list)) 
 (define (empty-termlist? term-list) 
   (apply-generic 'empty-termlist? term-list)) 
 (define (order term) 
   (apply-generic 'order term)) 
 (define (coeff term) 
   (apply-generic 'coeff term)) 
  
 (define make-sparse-empty-termlist 
   (get 'the-empty-termlist 'sparse)) 
 (define make-dense-empty-termlist 
   (get 'the-empty-termlist 'dense)) 
 (define (make-term order coeff) 
   ((get 'make-term 'term) order coeff)) 
  
  
 ;; Define the-empty-termlist used in mul-terms 
 ;; and mul-term-by-all-terms. 
 ;; Here we use make-sparse-empty-list, but 
 ;; make-dense-empty-termlist is also fine. 
 (define the-empty-termlist make-sparse-empty-list) 
  

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

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