2012-06-24

SICP Exercise 2.92: Dealing With Different Indeterminates - The "This is Not Easy!" Approach - Part 1

By imposing an ordering on variables, extend the polynomial package so that addition and multiplication of polynomials works for polynomials in different variables. (This is not easy!)

From Naïve to "Not Easy"

In what I called the "naïve approach" to this exercise, we based our solution upon the observation that a polynomial of one indeterminate can be expressed as a polynomial of another indeterminate by simply treating the former polynomial as the coefficient of the zero-order term of the latter polynomial. We also showed exposed the limitations of this approach using the following example arithmetic operation:
((5y2 + 2y - 1)x2 + (2y2 + y + 2)x - 3) - ((5x2 + 2x)y2 + (2x2 + x)y - (x2 - 2x + 5))
..which, using the naïve approach, would give us the result:
((5y2 + 2y - 1)x2 + (2y2 + y + 2)x - ((5x2 + 2x)y2 + (2x2 + x)y - (x2 - 2x - 2))
...but which, using the approach of first converting "one polynomial to the type of the other by expanding and rearranging terms" and then performing the calculation would work out as follows:
  ((5y2 + 2y - 1)x2 + (2y2 + y + 2)x - 3) - ((5x2 + 2x)y2 + (2x2 + x)y - (x2 - 2x + 5))
= ((5y2 + 2y - 1)x2 + (2y2 + y + 2)x - 3) - (5x2y2 + 2xy2 + 2x2y + xy - x2 + 2x - 5)
= ((5y2 + 2y - 1)x2 + (2y2 + y + 2)x - 3) - (5y2x2 + 2y2x + 2yx2 + yx - x2 + 2x - 5)
= ((5y2 + 2y - 1)x2 + (2y2 + y + 2)x - 3) - (5y2x2 + 2yx2 - x2 + 2y2x + yx + 2x - 5)
= ((5y2 + 2y - 1)x2 + (2y2 + y + 2)x - 3) - ((5y2 + 2y - 1)x2 + (2y2 + y + 2)x - 5)
= (5y2 + 2y - 1)x2 + (2y2 + y + 2)x - 3 - (5y2 + 2y - 1)x2 - (2y2 + y + 2)x + 5
= (5y2 + 2y - 1)x2 - (5y2 + 2y - 1)x2 + (2y2 + y + 2)x - (2y2 + y + 2)x - 3 + 5
= 5 - 3
= 2
In this post we're going to tackle the full "this is not easy" solution to the problem. However, as you'll see, doing so is going to require us to reconsider the decision we made about the interface for term-list representations we made back in exercise 2.90. Let's discuss what we need to do to see why...

Expanding and Rearranging Terms

In order to convert a polynomial into "canonical" form (i.e. "with the highest-priority variable dominant and the lower-priority variables buried in the coefficients") we need to perform a recursive expand and rearrange of the polynomial. Given a polynomial p we first ensure that all of the coefficients of p that are themselves polynomials are expressed in canonical form, then we "expand and collapse" p. Our example above shows how the expand and collapse works when its performed manually. Let's try to state the steps involved.

Given a polynomial p in y whose highest-priority variable is x, we can convert this into an equivalent polynomial in x with coefficients in y by:
  1. Iterating through the terms of p and, for each term:
    1. If the coefficient of the term is itself a polynomial then recursively expand and rearrange its terms to ensure that it is itself in canonical form. This is necessary as there may be a polynomial in x, or indeed in y buried somewhere in coefficients and these need to be raised to the top-level.
    2. Multiply the term's coefficient by yn, where n is the order of the term for which this is the coefficient. We can achieve this programmatically by creating a polynomial in y with a single term with order n and a coefficient of 1, and using this as the multiplicand representing yn.
    3. Convert the result of this multiplication into a polynomial in x. The process for this is identical to the one implemented by the procedure express-in which we developed in the naïve approach. I.e. If the result of the multiplication is not already polynomial in x then create a polynomial in x using the result of the multiplication as the coefficient of its zero-order term.
  2. Add the converted coefficients together.
You'll note that, in order to perform this processing, we need to know the original polynomial's indeterminate (y in this case) as we're iterating through the terms in order that we can construct appropriate polynomials (to represent yn) to multiply the coefficients by. We also need to convert the result of each multiplication into a polynomial in the principal variable (x). Our current choice of term-list interface hides the individual terms from the polynomial package. As a result, we'd have a choice between:
  • Passing both the principal and original variables to the term-list packages in order that they could both perform the multiplication and create the resulting polynomial in x.
  • Passing the original variable to the term-list packages in order that they could perform the multiplication and return a list of the resulting coefficients, which the polynomial package could turn into the resulting polynomial in x.
Neither of these are particularly appealing. The former approach means that the term-list package will have an operation that returns a polynomial. The latter approach means that the coefficients, which were previously hidden under our selected term-list interface, are suddenly exposed for this one operation.

So what do we do?

Time for a Rewrite

In the previous exercise we noted that we could have chosen an alternative, lower-level, interface to our term-list packages. If we had exposed an interface at the level of first-term, rest-terms, adjoin-term, the-empty-termlist and empty-termlist? then the terms (and so the coefficients) would not be hidden to the polynomial package, and so would mean that expanding and rearranging terms could be performed within the polynomial package itself. It would also allow us to replace a lot of duplicate (or very similar) operations from the term-list packages (i.e. add-terms, etc.) with a single implementation of each operation in the polynomial package.

We also noted in the previous exercise that if we'd made this choice of API then various issues would arise. We noted that the first-term operation would need to return a term, which would lead to a lot of term creation for dense term-lists. We also noted that, adjoin-term would need to take a tagged representation of a term whose tag would be stripped off when the actual operations were applied, meaning that term-list representations would need to be able to manipulate the internal representation of a term, destroying the encapsulation. A third issue we didn't raise is that of the-empty-termlist. This operation does not have any arguments, so it would not be possible for apply-generic to determine which of the installed versions of the operation to invoke.

So how can we address these issues?

Well the terms that get created by first-term for dense term-lists are normally going to be short-lived. So let's ignore this issue and assume that Scheme's garbage collector will take care of it efficiently.

As for the other two issues we can simply state that apply-generic is not the appropriate calling mechanism to use. We've defined the interface, so any valid implementation of a term-list must have implementations of adjoin-term and the-empty-termlist (as well as first-term, rest-terms and empty-termlist?). As a result we can implement the former by getting the operation installed under the operation key 'adjoin-term and the type tag of the term-list, then invoking it with the term we want to adjoin and the contents of the term-list that we want to adjoin to. Note that this way we don't lose the encapsulation of term. As for the-empty-termlist, we can simply select a default representation (I went for a sparse term-list) and get and use this instance of the operation.

In fact we can go further and remove 'sparse-terms and 'dense-terms from the tower-of-types entirely. They're internal representation details of the polynomial package, so it can be argued that they don't really belong in the tower. I know, I put them there in the first place. Hey, I'm allowed to change my mind, aren't I?

Exercise 2.90 Revisited

Okay, with that in mind, we can rewrite the sparse, dense and polynomial packages with this new interface. I.e. let's do exercise 2.90 all over again! We'll also include the changes necessary to support div-terms from exercise 2.91.

I'm not going to go through the rewrite step-by-step - I want to get onto the expansion and rearrangement of terms necessary to perform the full solution for this exercise. I will, however, provide a running commentary as we go through the code.

Sparse Term-Lists

So let's begin with the sparse package. We can basically keep the implementations of adjoin-term, the-empty-termlist, first-term, rest-terms and empty-termlist? as they are. However, I chose to rewrite ajoin-term so that it checks that we don't violate the invariants of the representation.
;;;
;;; Sparse
;;; 
(define (install-sparse-terms-package)
  ;; internal procedures
  ;; representation of terms and term lists
  (define (adjoin-term term term-list)
    (cond ((=zero? (coeff term)) term-list)
          ((or (empty-termlist? term-list)
               (> (order term) (order (first-term term-list))))
           (cons term term-list))
          (else (error
                 "Cannot adjoin term of lower order than term list -- ADJOIN-TERM"
                 (list term term-list)))))

  (define (the-empty-termlist) '())
  (define (first-term term-list) (car term-list))
  (define (rest-terms term-list) (cdr term-list))
  (define (empty-termlist? term-list) (null? term-list))
Creation of sparse term lists is pretty much identical to before...
  ;; creation
  (define (insert-term term terms)
    (if (empty-termlist? terms)
        (adjoin-term term terms)
        (let* ((head (first-term terms))
               (head-order (order head))
               (term-order (order term)))
          (cond ((> term-order head-order) (adjoin-term term terms))
                ((= term-order head-order)
                 (adjoin-term (make-term term-order (add (coeff term) (coeff head)))
                              (rest-terms terms)))
                (else (adjoin-term head (insert-term term (rest-terms terms))))))))
  (define (build-terms terms result)
    (if (null? terms)
        result
        (build-terms (cdr terms) (insert-term (car terms) result))))
  (define (make-from-terms terms)
    (build-terms terms (the-empty-termlist)))

  (define (convert-to-term-list coeffs)
    (if (null? coeffs)
        (the-empty-termlist)
        (adjoin-term (make-term (- (length coeffs) 1) (car coeffs))
                     (convert-to-term-list (cdr coeffs)))))
  (define (make-from-coeffs coeffs)
    (convert-to-term-list coeffs))
We'll also retain an implementation of sparse-terms->dense-terms for coercion purposes. However this is much simpler than before, as we're going to move the decision of when to coerce up into the polynomial package.
  ;; Coercion
  (define (sparse-terms->dense-terms L)
    ((get 'make-from-terms 'dense-terms) L))
And that's it for the sparse term-list operation implementations. We throw out all the higher-level term-list manipulation procedures (or rather we promote them up into the polynomial package). All that remains is to install these operations appropriately. Note when tagging is used. We don't tag the results of first-term, as this returns a term, or of empty-termlist?, as it's a predicate. However, we need to tag the results of the others as they return sparse term-lists.
  ;; interface to rest of the system
  (define (tag tl) (attach-tag 'sparse-terms tl))
  (put 'adjoin-term 'sparse-terms
       (lambda (t tl) (tag (adjoin-term t tl))))
  (put 'the-empty-termlist 'sparse-terms
       (lambda () (tag (the-empty-termlist))))
  (put 'first-term '(sparse-terms)
       (lambda (tl) (first-term tl)))
  (put 'rest-terms '(sparse-terms)
       (lambda (tl) (tag (rest-terms tl))))
  (put 'empty-termlist? '(sparse-terms)
       (lambda (tl) (empty-termlist? tl)))
  (put 'make-from-terms 'sparse-terms
       (lambda (terms) (tag (make-from-terms terms))))
  (put 'make-from-coeffs 'sparse-terms
       (lambda (coeffs) (tag (make-from-coeffs coeffs))))
  (put-coercion 'sparse-terms 'dense-terms sparse-terms->dense-terms)
  'done)

Dense Term-Lists

Dense term-lists require a bit more work. We still reduce the package down to the low-level operations only. However, previously these operations dealt with coefficients and orders separately. Now our term-list interface stipulates that these should operate on the higher-level term encapsulation. So adjoin-term splits a term into its components up front in order to perform the adjoining, while first-term has to construct a term of the appropriate order, using the head of the internal representation as the coefficient.

I've also taken an additional step here. I've provided a guarantee that first-term will always return the first non-zero term in the term-list, or a zero-order term with a coefficient of 0 if the term-list is empty. Similarly I've provided a guarantee that either the head of rest-terms will be a non-zero term, or there will be no more terms.
;;;
;;; Dense
;;; 
(define (install-dense-terms-package)
  ;; internal procedures
  ;; representation of term lists
  (define (adjoin-term term term-list)
    (let ((term-order (order term))
          (term-coeff (coeff term)))
      (cond ((=zero? term-coeff) term-list)
            ((= term-order (+ 1 (term-list-order term-list)))
             (cons term-coeff term-list))
            ((> term-order (term-list-order term-list))
             (adjoin-term term (cons zero term-list)))
            (else (error
                   "Cannot adjoin term of lower order than term list -- ADJOIN-TERM"
                   (list term term-list))))))
  (define (the-empty-termlist) '())
  (define (first-term term-list)
    (if (empty-termlist? term-list)
        (make-term 0 zero)
        (let ((head (car term-list)))
          (if (=zero? head)
              (first-term (cdr term-list))
              (make-term (term-list-order term-list) (car term-list))))))
  (define (rest-terms term-list)
    (let ((tail (cdr term-list)))
      (cond ((empty-termlist? tail) tail)
            ((=zero? (car tail)) (rest-terms tail))
            (else tail))))
  (define (empty-termlist? term-list) (null? term-list))
  (define (term-list-order term-list)
    (- (length term-list) 1))
The same thing occurs with the creation procedures. These are similar to before. However, we can take advantage of first-term returning a term and so bring the implementation into line with the sparse term-list implementation. Note that we retain the two separate implementations here though, rather than promoting it up to the polynomial package, as the orderings imposed upon the terms are internal details of the two representations. It just so happens that they use the same ordering.
  ;; Creation
  (define (strip-leading-zeros coeffs)
    (cond ((empty-termlist? coeffs) (the-empty-termlist))
          ((not (=zero? (first-term coeffs))) coeffs)
          (else (make-from-coeffs (rest-terms coeffs)))))
  (define (make-from-coeffs coeffs) coeffs)

  (define (insert-term term terms)
    (if (empty-termlist? terms)
        (adjoin-term term terms)
        (let* ((head (first-term terms))
               (head-order (order head))
               (term-order (order term)))
          (cond ((> term-order head-order) (adjoin-term term terms))
                ((= term-order head-order)
                 (adjoin-term (make-term term-order (add (coeff term) (coeff head)))
                              (rest-terms terms)))
                (else (adjoin-term head (insert-term term (rest-terms terms))))))))
  (define (build-terms terms result)
    (if (null? terms)
        result
        (build-terms (cdr terms) (insert-term (car terms) result))))
  (define (make-from-terms terms)
    (build-terms terms (the-empty-termlist)))
We retain the coercion procedure unchanged from before, although you'll note the lack of to-best-representation. As explained in the sparse term-list implementation we're going to push the decision about representation up to the polynomial package.
  ;; Coercion
  (define (dense-terms->sparse-terms L)
    ((get 'make-from-coeffs 'sparse-terms) L))
  
  ;; interface to rest of the system
  (put 'adjoin-term 'dense-terms
       (lambda (t tl) (tag (adjoin-term t tl))))
  (put 'the-empty-termlist 'dense-terms
       (tag (the-empty-termlist)))
  (put 'first-term '(dense-terms)
       (lambda (tl) (first-term tl)))
  (put 'rest-terms '(dense-terms)
       (lambda (tl) (tag (rest-terms tl))))
  (put 'empty-termlist? '(dense-terms)
       (lambda (tl) (empty-termlist? tl)))
  (put 'make-from-terms 'dense-terms
       (lambda (terms) (tag (make-from-terms terms))))
  (put 'make-from-coeffs 'dense-terms
       (lambda (coeffs) (tag (make-from-coeffs coeffs))))
  (put-coercion 'dense-terms 'sparse-terms dense-terms->sparse-terms)
  'done)
Having completed the sparse and dense term-list packages we can move onto the polynomial package itself. The basic creation representation and variable manipulation procedures remain as before.
;;;
;;; Polynomial wrapper package
;;; 
(define (install-polynomial-package)
  ;; internal procedures
  ;; representation of poly
  (define (make-poly variable term-list)
    (cons variable term-list))
  (define (make-from-coeffs variable coeffs)
    (make-poly variable
               ((get 'make-from-coeffs 'dense-terms) coeffs)))
  (define (make-from-terms variable terms)
    (make-poly variable
               ((get 'make-from-terms 'sparse-terms) terms)))
  
  (define (variable p) (car p))
  (define (term-list p) (cdr p))
  
  ;; variable tests and selection
  (define (variable? x) (symbol? x))
  (define (same-variable? v1 v2)
    (and (variable? v1)
         (variable? v2)
         (or (eq? v1 v2)
             (eq? v1 'unbound)
             (eq? v2 'unbound))))

  (define (select-variable p1 p2)
    (let ((v1 (variable p1)))
      (if (eq? v1 'unbound)
          (variable p2)
          v1)))
Next we add in the term-list manipulation operations here. As noted above we're making the assumption that 'adjoin-term must be installed for any valid term-list so we can get and call it directly, unbundling the contents of the term-list as we do so. We also stated that we'd use the empty term-list for sparse term-lists as our default empty term list. We'll just use apply-generic for the others to keep the code a bit cleaner, even though we'll not be taking advantage of any coercion.
  ;; Term-list manipulation
  (define (first-term L)
    (apply-generic 'first-term L))

  (define (rest-terms L)
    (apply-generic 'rest-terms L))

  (define (empty-termlist? L)
    (apply-generic 'empty-termlist? L))

  (define (adjoin-term term term-list)
    ((get 'adjoin-term (type-tag term-list)) term (contents term-list)))

  (define (the-empty-termlist)
    ((get 'the-empty-termlist 'sparse-terms)))
Now we provide the implementations of the arithmetic operations. To do this we need to bring the term-list portions of the operations back into the polynomial package. We can use the sparse term-list implementations from before as the interface we've changed to is the lower-level interface that sparse term-lists were using.
  
  ;; procedures used by add-poly
  (define (add-poly p1 p2)
    (make-poly (select-variable p1 p2)
               (add-terms (term-list p1)
                          (term-list p2))))
  (define (add-terms L1 L2)
    (cond ((empty-termlist? L1) L2)
          ((empty-termlist? L2) L1)
          (else
           (let ((t1 (first-term L1)) (t2 (first-term L2)))
             (cond ((> (order t1) (order t2))
                    (adjoin-term
                     t1 (add-terms (rest-terms L1) L2)))
                   ((< (order t1) (order t2))
                    (adjoin-term
                     t2 (add-terms L1 (rest-terms L2))))
                   (else
                    (adjoin-term
                     (make-term (order t1)
                                (add (coeff t1) (coeff t2)))
                     (add-terms (rest-terms L1)
                                (rest-terms L2)))))))))
  
    ;; procedures used by mul-poly
  (define (mul-poly p1 p2)
    (make-poly (select-variable p1 p2)
               (mul-terms (term-list p1)
                          (term-list p2))))
  (define (mul-terms L1 L2)
    (if (empty-termlist? L1)
        (the-empty-termlist)
        (add-terms (mul-term-by-all-terms (first-term L1) L2)
                   (mul-terms (rest-terms L1) L2))))
  (define (mul-term-by-all-terms t1 L)
    (if (empty-termlist? L)
        (the-empty-termlist)
        (let ((t2 (first-term L)))
          (adjoin-term
           (make-term (+ (order t1) (order t2))
                      (mul (coeff t1) (coeff t2)))
           (mul-term-by-all-terms t1 (rest-terms L))))))
  
  ;; procedures used by div-poly
  (define (div-poly p1 p2)
    (let ((variable (select-variable p1 p2))
          (result (div-terms (term-list p1) (term-list p2))))
      (list (make-poly variable (car result))
            (make-poly variable (cadr result)))))
  (define (div-terms L1 L2)
    (if (empty-termlist? L1)
        (list (the-empty-termlist) (the-empty-termlist))
        (let ((t1 (first-term L1))
              (t2 (first-term L2)))
          (if (> (order t2) (order t1))
              (list (the-empty-termlist) L1)
              (let* ((new-c (div (coeff t1) (coeff t2)))
                     (new-o (- (order t1) (order t2)))
                     (new-t (make-term new-o new-c))
                     (rest-of-result
                      (div-terms
                       (add-terms L1
                                  (negate-terms (mul-term-by-all-terms new-t L2)))
                        L2)))
                  (list (adjoin-term new-t (car rest-of-result))
                        (cadr rest-of-result)))))))
  
  ;; Subtraction
  (define (sub-poly p1 p2)
    (add-poly p1 (negate-poly p2)))
  
  ;; zero test
  (define (=zero-poly? p)
    (=zero-all-terms? (term-list p)))
  (define (=zero-all-terms? L)
    (cond ((empty-termlist? L) #t)
          ((not (=zero? (coeff (first-term L)))) #f)
          (else (=zero-all-terms? (rest-terms L)))))
  
  ;; Negation
  (define (negate-poly p)
    (make-poly (variable p)
               (negate-terms (term-list p))))
  (define (negate-terms L)
    (if (empty-termlist? L)
        (the-empty-termlist)
        (let ((term (first-term L)))
          (adjoin-term (make-term (order term)
                                  (negate (coeff term)))
                       (negate-terms (rest-terms L))))))
  
  ;; Equality
  (define (equ-poly? p1 p2)
    (and (same-variable? (variable p1) (variable p2))
         (equ-terms? (term-list p1) (term-list p2))))
  (define (equ-terms? L1 L2)
    (cond ((=zero-all-terms? L1) (=zero-all-terms? L2))
          ((empty-termlist? L2) #f)
          (else (and (equ? (first-term L1) (first-term L2))
                     (equ-terms? (rest-terms L1) (rest-terms L2))))))
As we noted above, our term-lists no longer exist within the type hierarchy, and so we'll perform any necessary coercions ourselves. If you remember, back in exercise 2.90 we introduced to-best-representation to the dense term-list package. We expand it somewhat here...

First, we can perform the calculation of zero-terms within the polynomial package generically, so we put an appropriate implementation here (i.e. the sparse term-list's implementation from before). Next, we can move the selection of which representation to use in here as well, as this is the only place where we need to make such a decision. Previously we used store-as-sparse?, which just told us whether or not sparse term-list representation should be used. I've replaced this with select-representation, which performs a similar calculation, but returns the representation to use. This then allows us to provide an implementation of to-best-representation which uses the current and desired type tags to look up the appropriate coercion operation to use.
  (define (calculate-zero-terms first rest)
    (if (empty-termlist? rest)
        (order first)
        (let ((next (first-term rest)))
          (+ (- (order first) (order next) 1)
             (calculate-zero-terms next (rest-terms rest))))))
  (define (select-representation highest-order zero-terms)
    (if (or (and (>= highest-order 10) (> (/ zero-terms highest-order) 0.1))
            (and (< highest-order 10) (> zero-terms (/ highest-order 5))))
        'sparse-terms
        'dense-terms))
  (define (to-best-representation L)
    (if (empty-termlist? L)
        L
        (let* ((first (first-term L))
               (current (type-tag L))
               (desired (select-representation (order first)
                                               (calculate-zero-terms first
                                                                     (rest-terms L)))))
          (if (eq? desired current)
              L
              (let ((raiser (get-coercion current desired)))
                (if raiser
                    (raiser (contents L))
                    (error "Missing coercion -- TO-BEST-REPRESENTATION"
                           (list current desired))))))))
Coercion between polynomial and complex types and variable coercion remain unchanged from before...
  ;; Coercion
  (define (get-constant L)
    (cond ((empty-termlist? L) zero)
          ((= (order (first-term L)) 0) (coeff (first-term L)))
          (else (get-constant (rest-terms L)))))
    
  (define (polynomial->complex p)
    (let ((constant (get-constant (term-list p))))
      (if (is-lower? constant 'complex)
          (raise-to 'complex constant)
          constant)))

  ;; Variable coercion
  (define (select-principal-variable v1 v2)
    (cond ((eq? v1 'unbound) v2)
          ((eq? v2 'unbound) v1)
          (else (let ((s1 (symbol->string v1))
                      (s2 (symbol->string v2)))
                  (if (string<=? s1 s2)
                      v1
                      v2)))))

  (define (express-in principal-variable p)
    (cond ((eq? principal-variable (variable p)) p)
          ((eq? 'unbound (variable p)) (make-poly principal-variable (term-list p)))
          (else (make-from-coeffs principal-variable (list (tag p))))))
  
  (define (coerce-and-call p1 p2 op)
    (let* ((principal (select-principal-variable (variable p1) (variable p2)))
           (new-p1 (express-in principal p1))
           (new-p2 (express-in principal p2)))
      (op new-p1 new-p2)))
...however, we now make use of to-best-representation to ensure that we select the best term-list representation for the results of arithmetic operations.
  
  ;; interface to rest of the system
  (define (tag p)
    (attach-tag 'polynomial
                (make-poly (variable p)
                           (to-best-representation (term-list p)))))
  (put 'add '(polynomial polynomial)
       (lambda (p1 p2) (tag (coerce-and-call p1 p2 add-poly))))
  (put 'mul '(polynomial polynomial)
       (lambda (p1 p2) (tag (coerce-and-call p1 p2 mul-poly))))
  (put 'div '(polynomial polynomial)
       (lambda (p1 p2)
         (let ((result (coerce-and-call p1 p2 div-poly)))
           (list (drop (tag (car result)))
                 (drop (tag (cadr result)))))))
  (put 'equ? '(polynomial polynomial) equ-poly?)
  (put '=zero? '(polynomial) =zero-poly?)
  (put 'negate '(polynomial)
       (lambda (p) (tag (negate-poly p))))
  (put 'sub '(polynomial polynomial)
       (lambda (p1 p2) (tag (coerce-and-call p1 p2 sub-poly))))
  (put 'make 'polynomial
       (lambda (var terms) (tag (make-poly var terms))))
  (put 'make-from-terms 'polynomial
       (lambda (variable terms) (tag (make-from-terms variable terms))))
  (put 'make-from-coeffs 'polynomial
       (lambda (variable coeffs) (tag (make-from-coeffs variable coeffs))))
  (put-coercion 'polynomial 'complex polynomial->complex)
  'done)
All that remains is to install the top-level creation procedures and install the packages.
(define (make-polynomial-from-coeffs variable coeffs)
  ((get 'make-from-coeffs 'polynomial) variable coeffs))

(define (make-polynomial-from-terms variable terms)
  ((get 'make-from-terms 'polynomial) variable terms))

(define (make-zero-order-polynomial-from-coeff coeff)
  ((get 'make-from-coeffs 'polynomial) 'unbound (list coeff)))

(install-term-package)
(install-sparse-terms-package)
(install-dense-terms-package)
(install-polynomial-package)

Retesting

Now all that remains is to re-run the tests we ran in exercise 2.90:
> (define dense
          (make-polynomial-from-coeffs 'x
                                       (list (make-integer 4)
                                             (make-integer 3)
                                             (make-integer 2)
                                             (make-integer 1)
                                             zero)))
> (define dense-with-many-zeros
          (make-polynomial-from-coeffs 'x
                                       (list (make-integer 42)
                                             zero
                                             zero
                                             zero
                                             zero
                                             zero
                                             (make-integer -1))))
> (define sparse
          (make-polynomial-from-terms 'x 
                                      (list (make-term 5 (make-integer 5))
                                            (make-term 3 (make-integer 3))
                                            (make-term 1 (make-integer 1)))))
> (define another-sparse
          (make-polynomial-from-terms 'x
                                      (list (make-term 5 (make-integer 5))
                                            (make-term 3 (make-integer 3))
                                            (make-term 1 (make-integer 1))
                                            (make-term 0 (make-integer 3)))))
> (define very-sparse
          (make-polynomial-from-terms 'x
                                      (list (make-term 50 (make-integer 150))
                                            (make-term 10 (make-integer 11))
                                            (make-term 0 (make-integer 1)))))
> (define polypoly
          (make-polynomial-from-coeffs
           'x
           (list (make-polynomial-from-coeffs 'y
                                              (list (make-integer 2)
                                                    (make-integer 1))))))
> (add polypoly dense)
(polynomial x
            dense-terms
            (integer . 4)
            (integer . 3)
            (integer . 2)
            (integer . 1)
            (polynomial y
                        dense-terms
                        (integer . 2)
                        (integer . 1)))
> (add polypoly polypoly)
(polynomial x
            dense-terms
            (polynomial y
                        dense-terms
                        (integer . 4)
                        (integer . 2)))
> (add (add polypoly polypoly) (make-integer 3))
(polynomial x
            dense-terms
            (polynomial y
                        dense-terms
                        (integer . 4)
                        (integer . 5)))
> (add dense dense-with-many-zeros)
(polynomial x
            dense-terms
            (integer . 42)
            (integer . 0)
            (integer . 4)
            (integer . 3)
            (integer . 2)
            (integer . 1)
            (integer . -1))
> (add dense-with-many-zeros dense-with-many-zeros)
(polynomial x
            sparse-terms
            (term 6 (integer . 84))
            (term 0 (integer . -2)))
> (add sparse sparse)
(polynomial x
            sparse-terms
            (term 5 (integer . 10))
            (term 3 (integer . 6))
            (term 1 (integer . 2)))
> (add sparse another-sparse)
(polynomial x
            sparse-terms
            (term 5 (integer . 10))
            (term 3 (integer . 6))
            (term 1 (integer . 2))
            (term 0 (integer . 3)))
> (add very-sparse sparse)
(polynomial x
            sparse-terms
            (term 50 (integer . 150))
            (term 10 (integer . 11))
            (term 5 (integer . 5))
            (term 3 (integer . 3))
            (term 1 (integer . 1))
            (term 0 (integer . 1)))
> (mul sparse dense)
(polynomial x
            sparse-terms
            (term 9 (integer . 20))
            (term 8 (integer . 15))
            (term 7 (integer . 22))
            (term 6 (integer . 14))
            (term 5 (integer . 10))
            (term 4 (integer . 6))
            (term 3 (integer . 2))
            (term 2 (integer . 1)))
> (add dense sparse)
(polynomial x
            dense-terms
            (integer . 5)
            (integer . 4)
            (integer . 6)
            (integer . 2)
            (integer . 2)
            (integer . 0))
> (sub sparse dense)
(polynomial x
            sparse-terms
            (term 5 (integer . 5))
            (term 4 (integer . -4))
            (term 2 (integer . -2)))
> (negate very-sparse)
(polynomial x
            sparse-terms
            (term 50 (integer . -150))
            (term 10 (integer . -11))
            (term 0 (integer . -1)))
> (sub (add dense (make-integer 1)) dense)
(integer . 1)
...and to re-run the tests we ran in exercise 2.91:
> (define sparse-numerator-1
    (make-polynomial-from-terms 'x
                                (list (make-term 5 (make-integer 1))
                                      (make-term 0 (make-integer -1)))))
> (define sparse-denominator-1
    (make-polynomial-from-terms 'x
                                (list (make-term 2 (make-integer 1))
                                      (make-term 0 (make-integer -1)))))
> (define sparse-numerator-2
    (make-polynomial-from-terms 'x
                                (list (make-term 2 (make-integer 2))
                                      (make-term 0 (make-integer 2)))))
> (define sparse-denominator-2
    (make-polynomial-from-terms 'x
                                (list (make-term 2 (make-integer 1))
                                      (make-term 0 (make-integer 1)))))
> (define sparse-numerator-3
    (make-polynomial-from-terms 'x
                                (list (make-term 4 (make-integer 3))
                                      (make-term 3 (make-integer 7))
                                      (make-term 0 (make-integer 6)))))
> (define sparse-denominator-3
    (make-polynomial-from-terms 'x
                                (list (make-term 4 (make-real 0.5))
                                      (make-term 3 (make-integer 1))
                                      (make-term 0 (make-integer 3)))))
> (define dense-numerator-1
    (make-polynomial-from-coeffs 'x
                                 (list (make-integer 1)
                                       zero
                                       zero
                                       zero
                                       zero
                                       (make-integer -1))))
> (define dense-denominator-1
    (make-polynomial-from-coeffs 'x
                                 (list (make-integer 1)
                                       zero
                                       (make-integer -1))))
> (define dense-numerator-2
    (make-polynomial-from-coeffs 'x
                                 (list (make-integer 2)
                                       zero
                                       (make-integer 2))))
> (define dense-denominator-2
    (make-polynomial-from-coeffs 'x
                                 (list (make-integer 1)
                                       zero
                                       (make-integer 1))))
> (define dense-numerator-3
    (make-polynomial-from-coeffs 'x
                                 (list (make-integer 3)
                                       (make-integer 7)
                                       zero
                                       zero
                                       (make-integer 6))))
> (define dense-denominator-3
    (make-polynomial-from-coeffs 'x
                                 (list (make-real 0.5)
                                       (make-integer 1)
                                       zero
                                       zero
                                       (make-integer 3))))
> (div sparse-numerator-1 sparse-denominator-1)
((polynomial x sparse-terms (term 3 (integer . 1)) (term 1 (integer . 1)))
 (polynomial x dense-terms (integer . 1) (integer . -1)))
> (div sparse-numerator-2 sparse-denominator-2)
((integer . 2)
 (integer . 0))
> (div sparse-numerator-3 sparse-denominator-3)
((integer . 6)
 (polynomial x sparse-terms (term 3 (integer . 1)) (term 0 (integer . -12))))
> (div dense-numerator-1 dense-denominator-1)
((polynomial x sparse-terms (term 3 (integer . 1)) (term 1 (integer . 1)))
 (polynomial x dense-terms (integer . 1) (integer . -1)))
> (div dense-numerator-2 dense-denominator-2)
((integer . 2)
 (integer . 0))
> (div dense-numerator-3 dense-denominator-3)
((integer . 6)
 (polynomial x sparse-terms (term 3 (integer . 1)) (term 0 (integer . -12))))
> (div dense-numerator-1 sparse-denominator-1)
((polynomial x sparse-terms (term 3 (integer . 1)) (term 1 (integer . 1)))
 (polynomial x dense-terms (integer . 1) (integer . -1)))
> (div sparse-numerator-1 dense-denominator-1)
((polynomial x sparse-terms (term 3 (integer . 1)) (term 1 (integer . 1)))
 (polynomial x dense-terms (integer . 1) (integer . -1)))
Right, now we can get on to tackling the "not easy!" approach.

2012-06-15

SICP Exercise 2.92: Dealing With Different Indeterminates - The Naïve Approach

By imposing an ordering on variables, extend the polynomial package so that addition and multiplication of polynomials works for polynomials in different variables. (This is not easy!)
I'm going to try to tackle this in a couple of ways. In this post I'm going to take a naïve approach, which will allow us to explore some portions of a solution. I hope to follow this up with a full "this is not easy!" approach.

The Naïve Approach

The naïve approach of ensuring "that both polynomials have the same principal variable" comes from the observation that a polynomial of one indeterminate can be expressed as a polynomial of another indeterminate by simply treating the former polynomial as the coefficient of the zero-order term of the latter polynomial.

In case that's not clear, here's an example of what I mean. I'll explicitly give the indeterminate and order of each term, including the order 1 and order 0 terms so it's easier to see what's been done. We can express a polynomial in y of the form:
Cnyn + Cn-1yn-1 + Cn-2yn-2 + … + C2y2 + C1y1 + C0y0
as a polynomial in x as follows:
(Cnyn + Cn-1yn-1 + Cn-2yn-2 + … + C2y2 + C1y1 + C0y0)x0
Why is this naïve? Well it won't cope particularly well when performing an arithmetic operations on a pair of polynomials where the first polynomial is a polynomial in one variable whose coefficients are polynomials in a second variable and the second polynomial is a polynomial in the second variable whose coefficients are polynomials in the first variable. As a concrete example of this, let's use this approach to subtract a polynomial in y whose coefficients are polynomials in x from a polynomial in x whose coefficients are polynomials in y:
  ((5y2 + 2y - 1)x2 + (2y2 + y + 2)x - 3) - ((5x2 + 2x)y2 + (2x2 + x)y - (x2 - 2x + 5))
= ((5y2 + 2y - 1)x2 + (2y2 + y + 2)x - ((5x2 + 2x)y2 + (2x2 + x)y - (x2 - 2x - 2))
...and that's as far as it goes.

To see why this is bad, let's see what happens if we "convert one polynomial to the type of the other by expanding and rearranging terms" and then perform the calculation. First, let's convert the second polynomial, which a polynomial in y with coefficients that are polynomials in x, to express it as a polynomial in x with coefficients that are polynomials in y:
  (5x2 + 2x)y2 + (2x2 + x)y - (x2 - 2x + 5)
= 5x2y2 + 2xy2 + 2x2y + xy - x2 + 2x - 5
= 5y2x2 + 2y2x + 2yx2 + yx - x2 + 2x - 5
= 5y2x2 + 2yx2 - x2 + 2y2x + yx + 2x - 5
= (5y2 + 2y - 1)x2 + (2y2 + y + 2)x - 5
Now we substitute the converted polynomial into the calculation:
  ((5y2 + 2y - 1)x2 + (2y2 + y + 2)x - 3) - ((5x2 + 2x)y2 + (2x2 + x)y - (x2 - 2x + 5))
= ((5y2 + 2y - 1)x2 + (2y2 + y + 2)x - 3) - ((5y2 + 2y - 1)x2 + (2y2 + y + 2)x - 5)
= (5y2 + 2y - 1)x2 + (2y2 + y + 2)x - 3 - (5y2 + 2y - 1)x2 - (2y2 + y + 2)x + 5
= (5y2 + 2y - 1)x2 - (5y2 + 2y - 1)x2 + (2y2 + y + 2)x - (2y2 + y + 2)x - 3 + 5
= 5 - 3
= 2
So, as we can see, the naïve approach will not simplify the results of arithmetic operations. However, as I said above, we'll not try to do anything more complex in this post than pursing the naïve approach.

Selecting a Variable

Regardless of approach, we need to be able to select an appropriate "principal variable" to express polynomials in before we can perform any conversion. The authors suggest that one way of achieving this is to "impose a towerlike structure on this by ordering the variables and thus always converting any polynomial to a 'canonical form' with the highest-priority variable dominant and the lower-priority variables buried in the coefficients." We can select any ordering for this, so long as it is predictable. Let's just use alphanumeric ordering.

You'll have noted that we're using Scheme symbols to represent our variables. Symbols have no concept of ordering associated with them... but strings do. We can convert symbols that represent variables into strings using the standard procedure symbol->string, and then test which should come first using the procedure string<=?. Of course, we'll need to remember the 'unbound variable we introduced in exercise 2.90. We should avoid selecting this as our principal if possible!

Programmatically we can express the selection as:
(define (select-principal-variable v1 v2)
  (cond ((eq? v1 'unbound) v2)
        ((eq? v2 'unbound) v1)
        (else (let ((s1 (symbol->string v1))
                    (s2 (symbol->string v2)))
                (if (string<=? s1 s2)
                    v1
                    v2)))))

Coercing to the Principal Variable

Given that we've determined the principal variable, the naïve approach makes coercing a polynomial so that it's expressed in terms of the principal variable is very straightforward. We simply check whether or not the polynomial is already expressed in terms of the principal variable and, if it isn't, we form a new polynomial in the principal variable with the original polynomial as the coefficient of the zero-order term.

Note that we can also bind 'unbound polynomials at this point. Doing so stops us from unnecessarily introducing an additional level of nesting to the coerced polynomial.

Here it is in code:
(define (express-in principal-variable p)
  (cond ((eq? principal-variable (variable p)) p)
        ((eq? 'unbound (variable p)) (make-poly principal-variable (term-list p)))
        (else (make-from-coeffs principal-variable (list (tag p))))))
Obviously this procedure lives within the polynomial package so that we can access the variable and term-list of the polynomial p. One implication of this is that p is untagged, hence the need to re-tag it before wrapping it in a list and passing it through to make-from-coeffs when we need to turn it into the coefficient of a zero-order term.

Making Use of the Coercion

Now all we need to do is to wire this in to the existing arithmetic operations. Currently add-poly, mul-poly and div-poly all test whether or not the polynomials passed to them are in the same variable and, if not, raise an error. sub-poly also applies this test, but does do via add-poly. We can remove this test entirely if we perform the coercion in the λ-expressions that are installed in the table as, by doing this change, we will guarantee that the polynomials passed to the procedures are in the same variable.

The general form of the change is to find the principal variable, coerce all of the polynomials so that they're expressed in terms of this variable and then invoke the appropriate procedure with these coerced polynomials. Rather than repeating this change in each of the λ-expressions we can note that these operations are all binary operations and extract the common functionality into a single procedure that takes the two polynomials and the procedure to apply and performs these steps:
(define (coerce-and-call p1 p2 op)
  (let* ((principal (select-principal-variable (variable p1) (variable p2)))
         (new-p1 (express-in principal p1))
         (new-p2 (express-in principal p2)))
    (op new-p1 new-p2)))
We can then modify the λ-expressions so that they use coerce-and-call rather than invoking the arithmetic operation procedures directly:
(put 'add '(polynomial polynomial) 
     (lambda (p1 p2) (tag (coerce-and-call p1 p2 add-poly))))
(put 'mul '(polynomial polynomial) 
     (lambda (p1 p2) (tag (coerce-and-call p1 p2 mul-poly))))
(put 'div '(polynomial polynomial) 
     (lambda (p1 p2)
       (let ((result (coerce-and-call p1 p2 div-poly)))
         (list (drop (tag (car result)))
               (drop (tag (cadr result)))))))
(put 'sub '(polynomial polynomial)
     (lambda (p1 p2) (tag (coerce-and-call p1 p2 sub-poly))))
Finally we can remove the same-variable? tests from the three arithmetic operation procedures:
;; procedures used by add-poly
(define (add-poly p1 p2)
  (make-poly (select-variable p1 p2)
             (add (term-list p1)
                  (term-list p2))))

;; procedures used by mul-poly
(define (mul-poly p1 p2)
  (make-poly (select-variable p1 p2)
             (mul (term-list p1)
                  (term-list p2))))

;; procedures used by div-poly
(define (div-poly p1 p2)
  (let ((variable (select-variable p1 p2))
        (result (div (term-list p1) (term-list p2))))
    (list (make-poly variable (car result))
          (make-poly variable (cadr result)))))

A Quick Spin

Okay, let's see this in action by trying out out the subtraction example we listed at the top of the exercise:
> (define poly-1
    (make-polynomial-from-coeffs
     'x
     (list (make-polynomial-from-coeffs
            'y
            (list (make-integer 5) (make-integer 2) (make-integer -1)))
           (make-polynomial-from-coeffs
            'y
            (list (make-integer 2) (make-integer 1) (make-integer 2)))
           (make-integer -3))))
> (define poly-2
    (make-polynomial-from-coeffs
     'y
     (list (make-polynomial-from-coeffs
            'x
            (list (make-integer 5) (make-integer 2) zero))
           (make-polynomial-from-coeffs
            'x
            (list (make-integer 2) (make-integer 1) zero))
           (make-polynomial-from-coeffs
            'x
            (list (make-integer -1) (make-integer 2) (make-integer -5))))))
> (sub poly-1 poly-2)
(polynomial x
            dense-terms
            (polynomial y
                        dense-terms
                        (integer . 5)
                        (integer . 2)
                        (integer . -1))
            (polynomial y
                        dense-terms
                        (integer . 2)
                        (integer . 1)
                        (integer . 2))
            (polynomial y
                        dense-terms
                        (polynomial x
                                    sparse-terms
                                    (term 2 (integer . -5))
                                    (term 1 (integer . -2)))
                        (polynomial x
                                    sparse-terms
                                    (term 2 (integer . -2))
                                    (term 1 (integer . -1)))
                        (polynomial x
                                    dense-terms
                                    (integer . 1)
                                    (integer . -2)
                                    (integer . 2))))
Right, now onto the full "this is not easy!" approach!

2012-06-04

SICP Exercise 2.91: Dividing Polynomials

A univariate polynomial can be divided by another one to produce a polynomial quotient and a polynomial remainder. For example,
x5 - 1 = x3 + x, remainder x - 1
x3 - 1
Division can be performed via long division. That is, divide the highest-order term of the dividend by the highest-order term of the divisor. The result is the first term of the quotient. Next, multiply the result by the divisor, subtract that from the dividend, and produce the rest of the answer by recursively dividing the difference by the divisor. Stop when the order of the divisor exceeds the order of the dividend and declare the dividend to be the remainder. Also, if the dividend ever becomes zero, return zero as both quotient and remainder.
We can design a div-poly procedure on the model of add-poly and mul-poly. The procedure checks to see if the two polys have the same variable. If so, div-poly strips off the variable and passes the problem to div-terms, which performs the division operation on term lists. Div-poly finally reattaches the variable to the result supplied by div-terms. It is convenient to design div-terms to compute both the quotient and the remainder of a division. Div-terms can take two term lists as arguments and return a list of the quotient term list and the remainder term list.
Complete the following definition of div-terms by filling in the missing expressions. Use this to implement div-poly, which takes two polys as arguments and returns a list of the quotient and remainder polys.
(define (div-terms L1 L2)
  (if (empty-termlist? L1)
      (list (the-empty-termlist) (the-empty-termlist))
      (let ((t1 (first-term L1))
            (t2 (first-term L2)))
        (if (> (order t2) (order t1))
            (list (the-empty-termlist) L1)
            (let ((new-c (div (coeff t1) (coeff t2)))
                  (new-o (- (order t1) (order t2))))
              (let ((rest-of-result
                     <compute rest of result recursively>
                     ))
                <form complete result>
                ))))))
If you've been following along then you'll note that, due to the internal operations that are defined within of our two term-list representations (which you can see in the previous exercise), this implementation of div-terms is only applicable to sparse term-lists. We represent dense term lists as a list of the coefficients only. As a result there are no order or coeff operations, the operation first-term simply returns the coefficient of the first term rather than a term representation, and we have a different operation, term-list-order, which acts on the whole term-list and calculates the order of the highest term in the list. So for this exercise we'll start by producing a full implementation for polynomials that use sparse term-list representations only and then derive a similar implementation for dense term-lists.

Note that had we chosen a different, lower-level, interface to our term-lists then this would not be an issue. We could have had sparse and dense term-lists expose order, coeff, first-term, rest-terms, adjoin-term, the-empty-termlist and empty-termlist?. If we had done so then this would have meant that the implementations of add-terms, mul-terms, div-terms and so on would have been identical regardless of term-list representation and so could have resided in the polynomial package rather than in the two term-list packages.

However there are issues with this approach. The first-term operation would need to return a representation of a term (i.e. order and coefficient), which would lead to a lot of term creation for dense term-lists. Worse still, adjoin-term would need to take a tagged representation of a term whose tag would be stripped off when the actual operations were applied. This would mean that both the sparse and dense term-list representations would need to be able to manipulate the internal representation of a term, destroying the encapsulation. We could prevent this by having apply-generic only strip the tags off objects that are of the "type" of the operation (so, for example, only objects tagged as sparse-terms would have their tags stripped when invoking adjoin-terms for a sparse term-list).

I did consider this approach when tackling the previous exercise, as it would allow for more sharing of code. However, on examining the implications of the approach I felt it would result in overly complex changes that would lead to additional issues. Feel free to give it a go yourself though!

Anyway, on with the exercise...

The authors have provided us with a template for a recursive implementation of div-terms that includes the terminating conditions (i.e. what happens when dividend becomes zero, and what happens when the order of the divisor exceeds the order of the dividend) and the calculation of the components of the next term in the result. To complete the implementation we have to flesh out two sections of the operation: the calculation of the rest-of-result value and the production of the final result.

Calculating rest-of-results

The calculation of the rest-of-result is described above as "multiply the result by the divisor, subtract that from the dividend, and produce the rest of the answer by recursively dividing the difference by the divisor." The result here is the order (new-o) and coefficient (new-c) of the next term in the final result. To perform the multiplication we can convert the result into a term, using make-term and then invoke mul-term-by-all-terms on that term and the divisor (L2):
(mul-term-by-all-terms (make-term new-o new-c) L2)
The subtraction is slightly more tricky, as we don't actually have a subtraction operation within the sparse term-list package (nor do we have one within the dense term-list package). Such an operation is easily derived from the sub-poly implementation however: we simply negate the subtrahend (the result of the multiplication) using negate-terms, and then add this to the minuend (L1) using add-terms. This gives us the following implementation:
(add-terms L1
           (negate-terms
            (mul-term-by-all-terms (make-term new-o new-c)
                                   L2)))
The final step in this is to produce the rest-of-result by dividing the result of this calculation by the divisor (L2). This is achieved by a recursive call to div-terms, and gives us the following completed implementation of the calculation:
(div-terms 
 (add-terms L1
            (negate-terms
             (mul-term-by-all-terms (make-term new-o new-c)
                                    L2)))
 L2)

Producing the Final Result

The final result we need to produce is "a list of the quotient term list and the remainder term list," and we know that the first term of the quotient is the term formed by new-o and new-c. The rest of the quotient comes from the recursive call, and is the first item of the list that this call returns. So in order to produce the quotient we need to create the term from new-o and new-c and adjoin it to the car of rest-of-results:
(adjoin-term (make-term new-o new-c) (car rest-of-result))
The remainder has already been calculated for us - it's just the second item in the rest-of-result. So we can calculate the result as follows:
(list (adjoin-term (make-term new-o new-c)
                   (car rest-of-result))
      (cadr rest-of-result))

Putting it All Together

Okay, so we can now fill in the blanks and complete div-terms as follows:
(define (div-terms L1 L2)
  (if (empty-termlist? L1)
      (list (the-empty-termlist) (the-empty-termlist))
      (let ((t1 (first-term L1))
            (t2 (first-term L2)))
        (if (> (order t2) (order t1))
            (list (the-empty-termlist) L1)
            (let ((new-c (div (coeff t1) (coeff t2)))
                  (new-o (- (order t1) (order t2))))
              (let ((rest-of-result
                     (div-terms 
                      (add-terms L1
                                 (negate-terms
                                  (mul-term-by-all-terms (make-term new-o new-c)
                                                         L2)))
                      L2)))
                (list (adjoin-term (make-term new-o new-c)
                                   (car rest-of-result))
                      (cadr rest-of-result))))))))
You'll note that we're creating the first term in the quotient twice here: once during the calculation of rest-of-terms and once when we produce the final result. We can remove this re-creation of the term, and collapse things slightly, with the following modification:
(define (div-terms L1 L2)
  (if (empty-termlist? L1)
      (list (the-empty-termlist) (the-empty-termlist))
      (let ((t1 (first-term L1))
            (t2 (first-term L2)))
        (if (> (order t2) (order t1))
            (list (the-empty-termlist) L1)
            (let* ((new-c (div (coeff t1) (coeff t2)))
                   (new-o (- (order t1) (order t2)))
                   (new-t (make-term new-o new-c))
                   (rest-of-result
                    (div-terms
                     (add-terms L1 (negate-terms (mul-term-by-all-terms new-t L2)))
                      L2)))
                (list (adjoin-term new-t (car rest-of-result))
                      (cadr rest-of-result)))))))
Let's install this into the table of operations... As with the other arithmetic operations we need to tag the term-lists we've produced. However, we can't simply tag the result of div-terms as this is a list containing two (untagged) sparse term-lists. Instead we have to split the list apart into its two components, tag each one individually, and then put them back together. Oh, and because we're not returning a tagged type apply-generic will not automatically coerce the result to a dense term-list if that's appropriate so we'll have to do that ourselves. We can do that by using sparse-terms->dense-terms to perform the tagging:
(put 'div '(sparse-terms sparse-terms) 
     (lambda (t1 t2)
       (let ((result (div-terms t1 t2)))
         (list (sparse-terms->dense-terms (car result))
               (sparse-terms->dense-terms (cadr result))))))
This split-modify-recombine pattern repeats itself in the polynomial package...

Our div-poly operation can perform the usual work to test the variables of the two polynomials passed to it and to select the appropriate variable to add to the term-lists generated. However, similar to the tagging of the term-lists, this variable needs to be added to both term-lists generated by div-terms. As a result we need to take the result of invoking div on the numerator and denominator term-lists, split it into the quotient and remainder term-lists, add the variable to both using make-poly and then recombine them:
(define (div-poly p1 p2)
  (if (same-variable? (variable p1) (variable p2))
      (let ((variable (select-variable p1 p2))
            (result (div (term-list p1) (term-list p2))))
        (list (make-poly variable (car result))
              (make-poly variable (cadr result))))
      (error "Polys not in same var -- DIV-POLY"
             (list p1 p2))))
Finally we need to install div-poly into the table of operations. Again, we need to split, modify and recombine. The modification in this case is tagging and then dropping the result (using drop) as, again, apply-generic will not be able to do this for us automatically:
  (put 'div '(polynomial polynomial) 
       (lambda (p1 p2)
         (let ((result (div-poly p1 p2)))
           (list (drop (tag (car result)))
                 (drop (tag (cadr result)))))))

Rinse and Repeat

As we noted at the start of the exercise, due to the way in which we've implemented the sparse and dense term-list packages, the implementation provided by the authors only applies to sparse term-lists. We need to provide a separate dense term-list implementation of div-terms that uses the internal operations available to us within that package. Thankfully deriving this implementation is straightforward.

The overall form is the same, but we need to alter the implementation to account for the different representation: a dense term-list is represented as a list of coefficients rather than a list of terms. So we obtain the order of the highest term in a term-list using the term-list itself, rather than the first term, and the coefficient of the highest term is the value returned by first-term. Also we don't need to build terms - mul-term-by-all-terms and adjoin-term work directly with the order and coefficient. Here's the implementation for dense term-lists:
  (define (div-terms L1 L2)
    (if (empty-termlist? L1)
        (list (the-empty-termlist) (the-empty-termlist))
        (let ((order-1 (term-list-order L1))
              (order-2 (term-list-order L2)))
          (if (> order-2 order-1)
              (list (the-empty-termlist) L1)
              (let* ((new-c (div (first-term L1) (first-term L2)))
                     (new-o (- order-1 order-2))
                     (rest-of-result
                      (div-terms
                       (add-terms L1
                                  (negate-terms (mul-term-by-all-terms new-o new-c L2)))
                       L2)))
                (list (adjoin-term new-o new-c (car rest-of-result))
                      (cadr rest-of-result)))))))
Installing this operation in the table is similar to installing the sparse term-list operation except that instead of using the coercion procedure sparse-terms->dense-terms we use to-best-representation, which performs the coercion in the opposite direction, raising the term-list to a sparse term-list if there are enough zero terms:
  (put 'div '(dense-terms dense-terms) 
       (lambda (t1 t2)
         (let ((result (div-terms t1 t2)))
           (list (to-best-representation (car result))
                 (to-best-representation (cadr result))))))

The Proof's In the Pudding

Okay, so let's give it a spin...

First we'll define a bunch of polynomials... We'll define numerators and denominators (as both sparse and dense term-lists) that will let us perform the following calculations:
  • (x5 - 1) / (x2 - 1) = x3 + x, remainder x - 1
  • (2x2 + 2) / (x2 + 1) = 2, remainder 0
  • (3x4 + 7x3 + 6) / (0.5x4 + x3 + 3) = 6, remainder x3 - 12
Here they are defined:
(define sparse-numerator-1
  (make-polynomial-from-terms 'x
                              (list (make-term 5 (make-integer 1))
                                    (make-term 0 (make-integer -1)))))

(define sparse-denominator-1
  (make-polynomial-from-terms 'x
                              (list (make-term 2 (make-integer 1))
                                    (make-term 0 (make-integer -1)))))

(define sparse-numerator-2
  (make-polynomial-from-terms 'x
                              (list (make-term 2 (make-integer 2))
                                    (make-term 0 (make-integer 2)))))

(define sparse-denominator-2
  (make-polynomial-from-terms 'x
                              (list (make-term 2 (make-integer 1))
                                    (make-term 0 (make-integer 1)))))

(define sparse-numerator-3
  (make-polynomial-from-terms 'x
                              (list (make-term 4 (make-integer 3))
                                    (make-term 3 (make-integer 7))
                                    (make-term 0 (make-integer 6)))))

(define sparse-denominator-3
  (make-polynomial-from-terms 'x
                              (list (make-term 4 (make-real 0.5))
                                    (make-term 3 (make-integer 1))
                                    (make-term 0 (make-integer 3)))))

(define dense-numerator-1
  (make-polynomial-from-coeffs 'x
                               (list (make-integer 1)
                                     zero
                                     zero
                                     zero
                                     zero
                                     (make-integer -1))))

(define dense-denominator-1
  (make-polynomial-from-coeffs 'x
                               (list (make-integer 1)
                                     zero
                                     (make-integer -1))))

(define dense-numerator-2
  (make-polynomial-from-coeffs 'x
                               (list (make-integer 2)
                                     zero
                                     (make-integer 2))))

(define dense-denominator-2
  (make-polynomial-from-coeffs 'x
                               (list (make-integer 1)
                                     zero
                                     (make-integer 1))))

(define dense-numerator-3
  (make-polynomial-from-coeffs 'x
                               (list (make-integer 3)
                                     (make-integer 7)
                                     zero
                                     zero
                                     (make-integer 6))))

(define dense-denominator-3
  (make-polynomial-from-coeffs 'x
                               (list (make-real 0.5)
                                     (make-integer 1)
                                     zero
                                     zero
                                     (make-integer 3))))
And here they are evaluated:
> (div sparse-numerator-1 sparse-denominator-1)
((polynomial x sparse-terms (term 3 (integer . 1)) (term 1 (integer . 1)))
 (polynomial x dense-terms (integer . 1) (integer . -1)))
> (div sparse-numerator-2 sparse-denominator-2)
((integer . 2)
 (integer . 0))
> (div sparse-numerator-3 sparse-denominator-3)
((integer . 6)
 (polynomial x sparse-terms (term 3 (integer . 1)) (term 0 (integer . -12))))
> (div dense-numerator-1 dense-denominator-1)
((polynomial x sparse-terms (term 3 (integer . 1)) (term 1 (integer . 1)))
 (polynomial x dense-terms (integer . 1) (integer . -1)))
> (div dense-numerator-2 dense-denominator-2)
((integer . 2)
 (integer . 0))
> (div dense-numerator-3 dense-denominator-3)
((integer . 6)
 (polynomial x sparse-terms (term 3 (integer . 1)) (term 0 (integer . -12))))
> (div dense-numerator-1 sparse-denominator-1)
((polynomial x sparse-terms (term 3 (integer . 1)) (term 1 (integer . 1)))
 (polynomial x dense-terms (integer . 1) (integer . -1)))
> (div sparse-numerator-1 dense-denominator-1)
((polynomial x sparse-terms (term 3 (integer . 1)) (term 1 (integer . 1)))
 (polynomial x dense-terms (integer . 1) (integer . -1)))