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

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

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

LisScheSic

If we trace the 2 added funcs in sicp-ex-2.89, when calling

mul-term-by-all-terms, we will end up with(the-empty-termlist)as the argumentterm-listofadjoin-term. So we need to change(the-empty-termlist). And by tracking L1 inadd-terms, we also need to changeempty-termlist?.IMHO Kaihao's implementation for that is not generic since it only allows one the-empty-termlist. Then if we call

(mul-term-by-all-terms t1 L)when L is dense, we will wrongly call sparseadjoin-term.one feasible implementation is using Kaihao's empty-termlist? but uses Rptx's (the-empty-termlist term-list) and do the related changes in mul-term-by-all-terms.