2012-09-07

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

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!)
In the post covering the naïve approach to this exercise we noted that you could express a polynomial, p, in one indeterminate as a polynomial in a different indeterminate by creating a new polynomial in the latter indeterminate with a single, zero-order, term that has the polynomial p as its coefficient. We also outlined why this was flawed, showing how it would fail to correctly simplify polynomials. As a result, in part 1 of the "This is Not Easy!" approach, we covered the steps required to convert a polynomial into "canonical" form. We also rewrote our representation of term lists there as a necessary prerequisite for producing the better solution.
In this post we're going to go through this better solution.

Test Polynomials

Before we get into the solution itself, I'm going to give us some polynomials to test with...
Polynomial p1: 5x2 + (10x2 + 6x + 4)x + 3
Canonical form: 10x3 + 11x2 + 4x + 3
(define p1
  (make-polynomial-from-coeffs
   'x
   (list (make-integer 5)
         (make-polynomial-from-coeffs
          'x
          (list (make-integer 10)
                (make-integer 6)
                (make-integer 4)))
         (make-integer 3))))
Polynomial p2: (10y2 + (10x2 + 6x + 4)y + 4)x2 + (10x2 + 6x + 4)x + 3
Canonical form: (10y)x4 + (6y + 10)x3 + (10y2 + 4y + 10)x2 + 4x + 3
(define p2
  (make-polynomial-from-coeffs
   'x
   (list (make-polynomial-from-coeffs
          'y
          (list (make-integer 10)
                (make-polynomial-from-coeffs
                 'x
                 (list (make-integer 10)
                       (make-integer 6)
                       (make-integer 4)))
                (make-integer 4)))
         (make-polynomial-from-coeffs
          'x
          (list (make-integer 10)
                (make-integer 6)
                (make-integer 4)))
         (make-integer 3))))
Polynomial p3: (x2 + 5x - 3)y2 + (2x2 + 3x + 1)y - 5
Canonical form: (y2 + 2y)x2 + (5y2 + 3y)x + (-3y2 + y - 5)
(define p3
  (make-polynomial-from-coeffs
   'y
   (list (make-polynomial-from-coeffs
          'x
          (list (make-integer 1)
                (make-integer 5)
                (make-integer -3)))
         (make-polynomial-from-coeffs
          'x
          (list (make-integer 2)
                (make-integer 3)
                (make-integer 1)))
         (make-integer -5))))
Polynomial p4: (5y2 + 2y - 1)x2 + (2y2 + y + 2)x - 3
Canonical form: (5y2 + 2y - 1)x2 + (2y2 + y + 2)x - 3
(define p4
  (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))))
Polynomial p5: (5x2 + 2x)y2 + (2x2 + x)y + (-x2 + 2x - 5)
Canonical form: (5y2 + 2y - 1)x2 + (2y2 + y + 2)x - 5
(define p5
  (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))))))
Polynomial p6: 42x0
Canonical form: 42unbound0 = 42
(define p6 (make-polynomial-from-coeffs 'x (list (make-integer 42))))
Note that p4 and p5 are the two polynomials shown in the naïve approach to this exercise. Once we've completed this implementation we should be able to evaluate (sub p4 p5) and get the result (integer . 2). Note also p6. This is a polynomial with only a single zero-order term. For such a polynomial the indeterminate is immaterial and so in canonical form its indeterminate is unbound (or it reduces to a constant if we drop the polynomial).

Overview of the Steps

We can summarise the steps we'll use in order to convert a polynomial into a canonical form as follows:
  1. Expand: Recursively multiply out the terms in the polynomial whose coefficients are themselves polynomials. As part of this step we'll rearrange the indeterminates in each expanded term into canonical (i.e. alphanumeric) order. We'll also drop any zero-order terms as we go as this simplifies combining expanded terms in the next step. For example, the polynomial:
        (10y2 + (10x2 + 6x + 4)y + 4)x2 + (10x2 + 6x + 4)x + 3
    becomes:
        10x2y2 + 10x4y + 6x3y + 4x2y + 4x2 + 10x3 + 6x2 + 4x + 3
  2. Rearrange: Iterate through the expanded terms and rearrange them such that the terms are sorted by decreasing order of the highest-priority indeterminate, then by decreasing order of the second-highest-priority indeterminate within that, and so on. We'll also combine expanded terms which have the same set of indeterminates and orders, adding their coefficients together, and dropping any whose coefficients become zero at this point. For example, the expansion:
        10x2y2 + 10x4y + 6x3y + 4x2y + 4x2 + 10x3 + 6x2 + 4x + 3
    becomes:
        10x4y + 6x3y + 10x3 + 10x2y2 + 4x2y + 10x2 + 4x + 3
  3. Collapse: Iterate through the rearranged terms building a term-list for the highest-priority indeterminate and finally constructing a polynomial from this. The term-list is constructed by grouping together all terms for the highest-priority indeterminate that are of the same order, recursively processing these terms (with the highest-priority indeterminate stripped off) to produce coefficients, producing appropriate ordered terms from these and combining them. For example, the rearranged expansion:
        10x4y + 6x3y + 10x3 + 10x2y2 + 4x2y + 10x2 + 4x + 3
    becomes:
        (10y)x4 + (6y + 10)x3 + (10y2 + 4y + 10)x2 + 4x + 3

Representing the Expansion

When we expand out a polynomial we produce an expression consisting of terms, each of which could be represented by a polynomial in its own right (a polynomial with only a single term, whose coefficient may be either a constant or another polynomial with a single term). So it initially seems as if we could just use our tagged polynomial representation to hold these terms and then use the existing polynomial addition to collapse the terms. Unfortunately, as we'll want to modify coerce-and-call (see here) so that it converts polynomials into canonical form before applying any operations we'd end up with an infinite recursion when we try to add the expanded terms together.
Instead of trying to deal with this via special-case code that prevents the recursion we'll produce a compressed intermediate representation of the expanded terms that we'll manipulate directly. We'll represent the expansion as a list, each element of which represents a single expanded term. Each expanded term will itself be a list, the first element of which will be a list of pairs of {indeterminate, order} ordered by indeterminate priority, and the second element of which will be the coefficient. For example, we'll represent the expansion 10x2y2 + 10x4y + 6x3y + 4x2y + 4x2 + 10x3 + 6x2 + 4x + 3 as:
((((x . 2) (y . 2)) integer . 10)
 (((x . 4) (y . 1)) integer . 10)
 (((x . 3) (y . 1)) integer . 6)
 (((x . 2) (y . 1)) integer . 4)
 (((x . 2)) integer . 4)
 (((x . 3)) integer . 10)
 (((x . 2)) integer . 6)
 (((x . 1)) integer . 4)
 (() integer . 3))
Note that the existing procedure for determining which indeterminate is of higher-priority, select-variable, deals with polynomial representations, not with the raw indeterminates themselves. Unfortunately we can't use this with our compressed representation. To address this we'll rename select-variable to select-variable-from-polys, as that's what it does, and then extract out a new implementation of select-variable that deals directly with the indeterminates:
(define (select-variable-from-polys p1 p2)
  (select-variable (variable p1) (variable p2)))
  
(define (select-variable v1 v2)
  (if (eq? v1 'unbound)
      v2
      v1))
We then update add-poly, mul-poly and div-poly to use select-variable-from-polys instead of select-variable and we're good to go!

Expanding Polynomials

Okay, so let's start with expanding out a polynomial to our intermediate representation. We know that this can be a recursive implementation, as we need to expand out any coefficient that is itself a polynomial. We also know that we'll be starting with the outer-most polynomial. Given this we can define the expansion process as iterating through all of the terms of the polynomial's term-list and, with each term:
  1. If the term's coefficient is itself a polynomial then recursively expand the coefficient. This produces an expansion using our intermediate representation.
  2. If the term's coefficient is not a polynomial then create an "expansion" in our intermediate representation that has a single expanded term consisting of an empty list of indeterminates and the coefficient. E.g. a term with the coefficient (integer . 3) would expand out to ((() (integer . 3))).
  3. Iterate through the expansion generated for the coefficient and, for each element in that expansion, incorporate the {indeterminate, order} pair corresponding to the polynomial and term being expanded. We need to remember that the indeterminates are to be kept in priority order in our intermediate representation. We also need to remember that a particular indeterminate may appear at different levels within the polynomial, in which case we need to update the indeterminate's order in the expanded term to be the sum of the orders involved. E.g. when expanding the representation of ((3x2)y3)x4 we need to spot that x appears not only as the indeterminate of the outermost polynomial, but also as the indeterminate of the innermost polynomial. As a result we need to generate the intermediate representation ((((x . 6) (y . 3)) integer . 3)) as opposed to ((((x . 2) (x . 4) (y . 3)) integer . 3))
  4. Finally, append the resulting expansion of this term onto the results of expanding the rest of the term-list.
Programmatically this can be expressed as:
(define (expand-poly p)
  (expand-terms (variable p) (term-list p)))
  
(define (expand-terms var tl)
  (if (empty-termlist? tl)
      '()
      (append (expand-term var (first-term tl))
              (expand-terms var (rest-terms tl)))))
  
(define (expand-term var term)
  (let* ((termcoeff (coeff term))
         (termorder (order term))
         (expanded (if (eq? (type-tag termcoeff) 'polynomial)
                       (expand-poly (contents termcoeff))
                       (list (cons '() termcoeff)))))
    (if (= termorder 0)
        expanded
        (expand-by-indeterminate var termorder expanded))))
  
(define (expand-by-indeterminate var order expansion)
  (if (null? expansion)
      '()
      (let ((head (car expansion)))
        (cons (cons (accumulate-indeterminate var order (car head)) (cdr head))
              (expand-by-indeterminate var order (cdr expansion))))))
  
(define (accumulate-indeterminate var termorder il)
  (if (null? il)
      (cons (cons var termorder) '())
      (let* ((head (car il))
             (head-var (car head)))
        (cond ((same-variable? var head-var)
               (cons (cons (select-variable var head-var)
                           (+ termorder (cdr head)))
                     (cdr il)))
              ((stringstring var) (symbol->string head-var))
               (cons (cons var termorder) il))
              (else (cons head
                          (accumulate-indeterminate var termorder (cdr il))))))))
The entry point to the expansion operation is expand-poly. This takes an untagged polynomial representation, splits out the indeterminate and term-list and invokes expand-termlist, which does the actual iteration through the terms in the term list. Note that we need to pass the indeterminate along with the term-list or term being expanded through to all of the procedures here as the representation of terms that we've been using contains only the order of the term and its coefficient; it does not contain the indeterminate.
The procedure expand-term encapsulates the logic for expanding a single term, examining the term's coefficient and then either recursively expanding it if it's a polynomial or building a single-term expansion consisting of no indeterminates and the coefficient if it's not. Once it's built the expansion of the term's coefficient it then multiplies each of the terms in the expansion by the the term's indeterminate and coefficient via expand-by-indeterminate. We use a minor optimization here - if the term is of order 0 then we skip this step as the net result of this multiplication is an unchanged expansion.
expand-by-indeterminate multiplies each term in the expansion by the indeterminate and order by iterating through the expansion and rebuilding each expansi (make-integer 2)))te, order} pairs via accumulate-indeterminate. This in turn iterates through the list of {indeterminate, order} pairs to locate the correct (sorted) location for the indeterminate being accumulated and either inserting it if it's missing or updating its order if it's present.
We can give this a quick spin by temporarily installing expand-poly:
(put 'expand-poly '(polynomial) expand-poly)
...and then creating a top-level procedure that allows us to apply this as a generic operation:
(define (expand-poly p)
  (apply-generic 'expand-poly p))
We can remove these when we're done with the exercise, as expansion is really an internal detail of the polynomial package. But in the meantime, let's try it out on our test polynomials:
> (expand-poly p1)
((((x . 2)) integer . 5)
 (((x . 3)) integer . 10)
 (((x . 2)) integer . 6)
 (((x . 1)) integer . 4)
 (() integer . 3))
> (expand-poly p2)
((((x . 2) (y . 2)) integer . 10)
 (((x . 4) (y . 1)) integer . 10)
 (((x . 3) (y . 1)) integer . 6)
 (((x . 2) (y . 1)) integer . 4)
 (((x . 2)) integer . 4)
 (((x . 3)) integer . 10)
 (((x . 2)) integer . 6)
 (((x . 1)) integer . 4)
 (() integer . 3))
> (expand-poly p3)
((((x . 2) (y . 2)) integer . 1)
 (((x . 1) (y . 2)) integer . 5)
 (((y . 2)) integer . -3)
 (((x . 2) (y . 1)) integer . 2)
 (((x . 1) (y . 1)) integer . 3)
 (((y . 1)) integer . 1)
 (() integer . -5))
> (expand-poly p4)
((((x . 2) (y . 2)) integer . 5)
 (((x . 2) (y . 1)) integer . 2)
 (((x . 2)) integer . -1)
 (((x . 1) (y . 2)) integer . 2)
 (((x . 1) (y . 1)) integer . 1)
 (((x . 1)) integer . 2)
 (() integer . -3))
> (expand-poly p5)
((((x . 2) (y . 2)) integer . 5)
 (((x . 1) (y . 2)) integer . 2)
 (((x . 2) (y . 1)) integer . 2)
 (((x . 1) (y . 1)) integer . 1)
 (((x . 2)) integer . -1)
 (((x . 1)) integer . 2)
 (() integer . -5))
> (expand-poly p6)
((() integer . 42))
You'll note that, as we've yet to perform the rearrangement, the expanded terms are not ordered in a way that's useful to us and, in some cases, there are multiple expanded terms with the same set of {indeterminate, order} values. We'll sort this next...

Rearranging the Expansion

As noted above, rearranging the expansion means sorting the expanded terms by decreasing order of the highest-priority indeterminate, then by decreasing order of the second-highest-priority indeterminate within that, and so on. And we perform the combining of expanded terms with the same set of {indeterminate, order} values at this stage.
This can be achieved by iterating through the expansion one term at a time, inserting that term appropriately into the results of rearranging the remainder of the expansion. In the implementation below we perform this iteration in rearrange-expansion, calling out to add-to-expansion-in-order to perform the insertion. This in turn simply iterates through the existing expansion, comparing the {indeterminate, order} set of the term to be inserted with {indeterminate, order} set of the head of the expansion. What happens next depends upon the results of the comparison:
  • If the term should precede the head in our desired ordering then it prepends the term onto the expansion, ending the iteration at this point.
  • If the term should follow the head in our desired ordering then it adds the head onto the results of recursively inserting the term into the tail of the expansion.
  • If the {indeterminate, order} set of the term matches the {indeterminate, order} set of the head then we need to combine the term and the head into a single new term. To do this we add the coefficients of the term and the head together. If the result is zero then we can eliminate the combined term from the result altogether, and so we just return the tail of the expansion. Otherwise we generate a new combined term with the term's {indeterminate, order} set and the results of the addition as the coefficient. This is prepended onto the expansion. Either way the iteration stops at this point.
The comparison of {indeterminate, order} sets is encapsulated in compare-expanded-vars. We follow the convention followed in many programming languages when comparing two values: return a negative value if the first value precedes the second value in the ordering, return zero if they are equivalent, and return a positive value if the first value should follow the second value in the ordering. As we're comparing two ordered sets of {indeterminate, order} values we simply iterate through the lists in parallel, looking for the first point at which the {indeterminate, order} values differ. When we find this point we decide which comes first based upon which has the principal variable of the two or, if they are the same value, which has the higher order. If we reach the end of either list during this process then we select the list which hasn't ended as the first in the ordering. If they've both ended then the two sets are identical.
Here's the code:
(define (rearrange-expansion expansion)
  (if (null? expansion)
      '()
      (add-to-expansion-in-order (car expansion)
                                 (rearrange-expansion (cdr expansion)))))
  
(define (add-to-expansion-in-order component expansion)
  (if (null? expansion)
      (cons component expansion)
      (let* ((var (car component))
             (compare (compare-expanded-vars var (caar expansion))))
        (cond ((< compare 0)
               (cons component expansion))
              ((> compare 0)
               (cons (car expansion)
                     (add-to-expansion-in-order component (cdr expansion))))
              (else
               (let ((combined (add (cdr component) (cdar expansion))))
                 (if (=zero? combined)
                     (cdr expansion)
                     (cons (cons var combined) (cdr expansion)))))))))

(define (compare-expanded-vars vars1 vars2)
  (cond ((null? vars1) (if (null? vars2) 0 1))
        ((null? vars2) -1)
        ((same-variable? (caar vars1) (caar vars2))
         (let ((order-diff (- (cdar vars2) (cdar vars1))))
           (if (= order-diff 0)
               (compare-expanded-vars (cdr vars1) (cdr vars2))
               order-diff)))
        (else (let* ((var1 (caar vars1))
                     (var2 (caar vars2))
                     (principal (select-principal-variable var1 var2)))
                (if (same-variable? principal var1)
                    -1
                    1)))))
Let's give this a quick test too. We follow a similar process, temporarily installing rearrange-expansion and a corresponding top-level procedure. Note that as this deals with an untagged value we'll just install it under the 'polynomial type tag, like the constructor, rather than under a type list, and access the table directly using get in the top-level procedure. Here's the installation:
(put 'rearrange-expansion 'polynomial rearrange-expansion)
...and, here's the top-level procedure:
(define (rearrange-expansion e)
  ((get 'rearrange-expansion 'polynomial) e))
Here's what happens when we apply it to the results of expanding our test polynomials:
> (rearrange-expansion (expand-poly p1))
((((x . 3)) integer . 10)
 (((x . 2)) integer . 11)
 (((x . 1)) integer . 4)
 (() integer . 3))
> (rearrange-expansion (expand-poly p2))
((((x . 4) (y . 1)) integer . 10)
 (((x . 3) (y . 1)) integer . 6)
 (((x . 3)) integer . 10)
 (((x . 2) (y . 2)) integer . 10)
 (((x . 2) (y . 1)) integer . 4)
 (((x . 2)) integer . 10)
 (((x . 1)) integer . 4)
 (() integer . 3))
> (rearrange-expansion (expand-poly p3))
((((x . 2) (y . 2)) integer . 1)
 (((x . 2) (y . 1)) integer . 2)
 (((x . 1) (y . 2)) integer . 5)
 (((x . 1) (y . 1)) integer . 3)
 (((y . 2)) integer . -3)
 (((y . 1)) integer . 1)
 (() integer . -5))
> (rearrange-expansion (expand-poly p4))
((((x . 2) (y . 2)) integer . 5)
 (((x . 2) (y . 1)) integer . 2)
 (((x . 2)) integer . -1)
 (((x . 1) (y . 2)) integer . 2)
 (((x . 1) (y . 1)) integer . 1)
 (((x . 1)) integer . 2)
 (() integer . -3))
> (rearrange-expansion (expand-poly p5))
((((x . 2) (y . 2)) integer . 5)
 (((x . 2) (y . 1)) integer . 2)
 (((x . 2)) integer . -1)
 (((x . 1) (y . 2)) integer . 2)
 (((x . 1) (y . 1)) integer . 1)
 (((x . 1)) integer . 2)
 (() integer . -5))
> (rearrange-expansion (expand-poly p6))
((() integer . 42))
All's looking good here. The terms are ordered as we need them in order to perform a simple collapse. Note in particular that the rearranged expansions of p1 and p2 differ only in their last terms, which are -3 and -5 respectively (and (-3) - (-5) = 2, so this looks very promising).

Compressing the Rearranged Expansion

All that remains in converting to canonical form is to collapse the rearranged expansion. The expansion is now ordered so that we can iterate through it, group together all terms of the same order in the principal variable, recursively collapse those to give a coefficient for a term of that order, and create a polynomial in the highest-priority indeterminate using the term-list that results from the iteration. So it should be straightforward then...
Our top-level procedure for performing the collapse basically has to identify the highest-priority indeterminate, collapse the expanded terms into a term-list and then create a polynomial from this. There are a couple of cases that need special treatment here:
  1. If the expanded terms list is empty then we want to create an "empty" polynomial. To do this we'll directly create a polynomial with an 'unbound indeterminate and a zero-order term with the coefficient of zero.
  2. If the expansion consists of a single expanded term which has an empty set of {indeterminate, order} values then the expansion corresponds to a polynomial with only a zero-order term. Any polynomial with only a zero-order term is effectively a constant, so the indeterminate is immaterial (which is just as well as we don't know it!). So, similar to the previous case, we'll create a polynomial with an 'unbound indeterminate and only a zero-order term. However, in this case we'll set the coefficient to the coefficient of the expanded term.
Here's the top-level procedure, which I've called collapse-expansion:
(define (collapse-expansion expanded)
  (cond ((null? expanded) (make-from-coeffs 'unbound (list zero)))
        ((null? (caar expanded)) (make-from-coeffs 'unbound (list (cdar expanded))))
        (else (let* ((first (car expanded))
                     (principal (caaar first))
                     (start-order (cdaar first))
                     (collapsed-tl (to-collapsed-term-list expanded
                                                           principal
                                                           start-order
                                                           '())))
                (make-poly principal collapsed-tl)))))
You'll note that we delegate the building of the collapsed term-list to another procedure, to-collapsed-term-list, which we'll move onto now. You'll also note that our procedure for doing this takes four operands:
  1. The list of expanded terms to be processed. We'll iterate through this list, grouping together all expanded terms for the highest-priority indeterminate that are of the same order.
  2. The indeterminate of the polynomial we're going to create with the collapsed term-list. We need this as not every expanded term may contain the highest-priority indeterminate. Such expanded terms, if present, will be at the end of the list and need to be grouped together to produce the coefficient for the zero-order term in the term-list.
  3. The current order we're grouping together. Initially this is the order associated with the highest-priority indeterminate in the first expanded term, which will be the highest order we'll encounter for this indeterminate. As we reach the start of each group we'll update this to be the order associated with the highest-priority indeterminate in the first expanded term in that group.
  4. A list in which to group (or accumulate) the expanded terms that have the same order for the highest-priority indeterminate. So long as the first expanded term in the remaining expansion belongs to the group we append it onto this accumulator. We strip off the {indeterminate, order} for the highest-priority indeterminate prior to doing this so that the expanded terms in our accumulated group correspond directly to the expansion of the coefficient of the current order's term. When we reach the point where we encounter the start of the next group we then construct a term with a coefficient built by collapsing this group and add it onto the term-list produced by the remainder of the expansion. Obviously we reset the accumulator at this point.
Okay, so here are the cases we'll encounter and how we'll deal with them:
  • If we've exhausted the expansion and there's nothing in the current group to convert into a term then we produce an empty term-list.
  • If we've exhausted the expansion but the current group isn't empty then we collapse the current group, use this as a coefficient in a term with the order of the group and add this term to an empty term-list.
  • If we're currently processing a non-zero term for the indeterminate of the polynomial we're constructing and we reach an expanded term which either has no list of {indeterminate, order} values, or for which the first indeterminate does not match the indeterminate of the polynomial we're constructing then we've found the start of the zero-order term's coefficients. We create a term for the current group as above, which we append onto the results of collapsing the remainder of the expansion. Note that in this case we know that the remainder forms the zero-order term for the term-list and none of the expansions have terms in the polynomial's indeterminate so we can immediately group the remainder of the expansion together to construct a coefficient with without having to iterate it.
  • The flip side of the previous case: if we're currently processing a zero term for the indeterminate of the polynomial we're constructing and we reach an expanded term which either has no list of {indeterminate, order} values, or for which the first indeterminate does not match the indeterminate of the polynomial we're constructing then we're in the zero term's group already. We simply append the remainder of the expansion directly onto the group and construct a term-list containing the zero-term by collapsing the group.
  • If we're currently processing a non-zero term for the indeterminate of the polynomial we're constructing and we reach an expanded term which has a different order for the indeterminate then we've found the start of next group. As above we create a term which we append onto the results of collapsing the remainder of the expansion. In this case, however, we can't short-cut the collapsing of the remaining expansion. We update the current order to be the order associated with the highest-priority indeterminate in the first expanded term in the expansion, reset the group and recursively process the expansion.
  • Finally, if no other case has dealt with the head of the expansion then we're in the middle of a group, so we append the expanded term onto the group (stripping off the highest-priority indeterminate) and move on to processing the remainder of the expansion after this.
If you've followed all that then you'll appreciate it's not overly straightforward. I'm not overly happy with my implementation of this, but for what it's worth, here it is. You'll note the use of caaaar and cdaaar here. The former gets the indeterminate associated with the first expanded term in the expansion, while the latter gets the order associated with the first expanded term in the expansion. Ouch!
(define (to-collapsed-term-list expanded principal current-order current-group)
  (cond ((and (null? expanded) (null? current-group)) (the-empty-termlist))
        ((null? expanded)
         (adjoin-term (make-term current-order
                                 (collapse-sub-expansion current-group))
                      (the-empty-termlist)))
        ((and (not (= current-order 0))
              (or (null? (caar expanded))
                  (not (eq? principal (caaaar expanded)))))
         (adjoin-term (make-term current-order
                                 (collapse-sub-expansion current-group))
                      (to-collapsed-term-list '() principal 0 expanded)))
        ((or (null? (caar expanded))
             (not (eq? principal (caaaar expanded))))
         (to-collapsed-term-list '()
                                 principal
                                 current-order
                                 (append current-group expanded)))
        ((and (not (= current-order 0))
              (not (= current-order (cdaaar expanded))))
         (adjoin-term (make-term current-order
                                 (collapse-sub-expansion current-group))
                      (to-collapsed-term-list expanded
                                              principal
                                              (cdaaar expanded)
                                              '())))
        (else
         (to-collapsed-term-list (cdr expanded)
                                 principal
                                 current-order
                                 (append current-group
                                         (list (cons (cdaar expanded)
                                                     (cdar expanded))))))))
Also, if you were really paying close attention, you'll have noted that we're not using collapse-expansion to collapse the groups, but a new procedure, collapse-sub-expansion. The two procedures are similar-ish to each other. They both have three identical cases to deal with: an empty expansion; a single element in the expansion with no {indeterminate, order} values; and an expansion in which at least the first expanded term has {indeterminate, order} values. The procedures have to deal with them slightly differently though:
  • We noted already that collapse-expansion generates a polynomial regardless of the expansion passed to it. This is necessary as the collapsed expansion is going to be passed to an arithmetic operation that is internal to the polynomial package. As they're internal arithmetic operations type coercion will not be applied to the arguments and our arithmetic operations require polynomial arguments.
  • In the case of collapse-sub-expansion the result will be used to form the coefficient of a collapsed term. As a result we want this to be expressed in as simple a form as possible. So in the first two cases, rather than generating polynomials in 'unbound with a single zero-order term, we'll generate a non-polynomial value. I.e. zero in the first case, and the coefficient of the expanded term in the second case. We also have to deal with the third case slightly differently: we have to tag it as a polynomial. This is necessary as coefficients of terms must be properly tagged types.
Here's collapse-sub-expansion:
(define (collapse-sub-expansion expanded)
  (cond ((null? expanded) zero)
        ((null? (caar expanded)) (cdar expanded))
        (else (let* ((first (car expanded))
                     (principal (caaar first))
                     (start-order (cdaar first))
                     (collapsed-tl (to-collapsed-term-list expanded
                                                           principal
                                                           start-order
                                                           '())))
                (tag (make-poly principal collapsed-tl))))))
To put this to the test, let's put another piece of the puzzle into place. We'll need to be able to convert a given polynomial into canonical form within the polynomial package, so let's string together the expand, rearrange and collapse steps from above into a single procedure which produces an untagged polynomial:
(define (to-canonical-poly p)
  (collapse-expansion (rearrange-expansion (expand-poly p))))
We can then expose this procedure externally by installing it such that it tags the produced polynomials and then drops them to reduce them to simplest form:
(put 'to-canonical '(polynomial)
     (lambda (p) (drop (tag (to-canonical-poly p)))))
...and then create a top-level procedure that allows us to apply this as a generic operation:
(define (to-canonical p)
  (apply-generic 'to-canonical p))
Finally we can apply this to our test polynomials:
> (to-canonical p1)
(polynomial x dense-terms (integer . 10) (integer . 11) (integer . 4) (integer . 3))
> (to-canonical p2)
(polynomial x
            dense-terms
            (polynomial y
                        sparse-terms
                        (term 1 (integer . 10)))
            (polynomial y
                        dense-terms
                        (integer . 6)
                        (integer . 10))
            (polynomial y
                        dense-terms
                        (integer . 10)
                        (integer . 4)
                        (integer . 10))
            (integer . 4)
            (integer . 3))
> (to-canonical p3)
(polynomial x
            dense-terms
            (polynomial y
                        sparse-terms
                        (term 2 (integer . 1))
                        (term 1 (integer . 2)))
            (polynomial y
                        sparse-terms
                        (term 2 (integer . 5))
                        (term 1 (integer . 3)))
            (polynomial y
                        dense-terms
                        (integer . -3)
                        (integer . 1)
                        (integer . -5)))
> (to-canonical p4)
(polynomial x
            dense-terms
            (polynomial y
                        dense-terms
                        (integer . 5)
                        (integer . 2)
                        (integer . -1))
            (polynomial y
                        dense-terms
                        (integer . 2)
                        (integer . 1)
                        (integer . 2))
            (integer . -3))
> (to-canonical p5)
(polynomial x
            dense-terms
            (polynomial y
                        dense-terms
                        (integer . 5)
                        (integer . 2)
                        (integer . -1))
            (polynomial y
                        dense-terms
                        (integer . 2)
                        (integer . 1)
                        (integer . 2))
            (integer . -5))
> (to-canonical p6)
(integer . 42)
These all correspond to the canonical forms listed for the test polynomials given above, so we're nearly there!

Integrating into the System

The final piece of the puzzle is to add automatic conversion to canonical form to our system. We already have a procedure, coerce-and-call which ensures that two polynomials are expressed in the same indeterminate before applying the operation which we used to implement the naïve solution. To add conversion to canonical form to this we simply extend the let* statement so that it firstly converts the two polynomials to canonical form. Note that we still need to ensure they're both expressed in the same indeterminate prior to applying the operation after we've converted them to canonical form!
Here's the updated coerce-and-call:
(define (coerce-and-call p1 p2 op)
  (let* ((canonical-p1 (to-canonical-poly p1))
         (canonical-p2 (to-canonical-poly p2))
         (principal (select-principal-variable (variable canonical-p1)
                                               (variable canonical-p2)))
         (new-p1 (express-in principal canonical-p1))
         (new-p2 (express-in principal canonical-p2)))
    (op new-p1 new-p2)))
Finally, let's do some sums:
> (add p1 p2)
(polynomial x
            dense-terms
            (polynomial y
                        sparse-terms
                        (term 1 (integer . 10)))
            (polynomial y
                        dense-terms
                        (integer . 6)
                        (integer . 20))
            (polynomial y
                        dense-terms
                        (integer . 10)
                        (integer . 4)
                        (integer . 21))
            (integer . 8)
            (integer . 6))
> (add p4 p5)
(polynomial x
            dense-terms
            (polynomial y
                        dense-terms
                        (integer . 10)
                        (integer . 4)
                        (integer . -2))
            (polynomial y
                        dense-terms
                        (integer . 4)
                        (integer . 2)
                        (integer . 4))
            (integer . -8))
> (sub p4 p5)
(integer . 2)
> (add p6 p3)
(polynomial x
            dense-terms
            (polynomial y
                        sparse-terms
                        (term 2 (integer . 1))
                        (term 1 (integer . 2)))
            (polynomial y
                        sparse-terms
                        (term 2 (integer . 5))
                        (term 1 (integer . 3)))
            (polynomial y
                        dense-terms
                        (integer . -3)
                        (integer . 1)
                        (integer . 37)))
> (add p6 p6)
(integer . 84)
Cool - looks like we have a working solution! And phew! That took a while! Now onto exercise 2.93...

SICP Exercise 2.92: Quick Update

If you remember, back in what I called the Naïve Approach, I gave an example subtraction of two polynomials:
((5y2 + 2y - 1)x2 + (2y2 + y + 2)x - 3) - ((5x2 + 2x)y2 + (2x2 + x)y - (x2 - 2x + 5))
...and showed how the naïve approach (i.e. expressing one polynomial in the same indeterminate as the other by simply creating a new polynomial of the required indeterminate with only a zero-order term with the coefficient being the first polynomial) failed to correctly simplify the results, giving:
((5y2 + 2y - 1)x2 + (2y2 + y + 2)x - ((5x2 + 2x)y2 + (2x2 + x)y - (x2 - 2x - 2))
...instead of:
2
Well, here's the output from my Scheme interpreter this morning:
> (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)
(integer . 2)
Write-up to follow. Unfortunately I'm away this weekend, so it may not be posted until sometime next week. However, I'm pretty chuffed I've finally found the time to finish this exercise off!

2012-08-28

Stalled Again!

Okay, so it's been two months since my last post. Worse still, in my last post I was in the middle of reworking exercise 2.92. Sorry to keep you hanging...
I'm sure you'll be pleased to hear that, no, I've not abandoned this. I've just been really busy, particularly at work, which means I've not had a chance to do much work on finishing this off. I'll give you a progress report though.
First thing to note is that the "This is not easy!" from the exercise description is quite right, which is why I've not managed to finish it yet. It requires little a bit more than five minutes grabbed here and there. So I imagine there'll still be a bit more of a delay before I finally post my solution.
I have made some progress however:
  1. I've defined an ordering on variables (alphanumeric rocks!) which implies a particular canonical form for polynomials.
  2. Using this I've produced a procedure which takes a polynomial and expands all of the terms of it (into a simplified form, not the tagged form we've been using). E.g. it'll take the polynomial (x2 + 5x - 3)y2 + (2x2 + 3x + 1)y - 5
  3. and expand this to (y2)x2 + (5y2)x - 3y2 + (2y)x2 + (3y)x + y - 5
  4. I have a further procedure which can take the expansion and rearrange the terms so that they are sorted by decreasing order of terms and sub-terms. I.e. it would take the results of the previous expansion and rearrange it as: (y2)x2 + (2y)x2 + (5y2)x + (3y)x - 3y2 + y - 5
The next stage of the process will be to collapse the rearranged polynomial. To do this I'll need to determine what the canonical top-level indeterminate is for the rearranged form (which is simply the outer-most indeterminate for the first expanded term). Having done that I'll need to pass through the top-level, gather together all expanded terms which have the same order for the outer-most indeterminate, recurse on those to produce a coefficient for that order and create the corresponding term, gathering the resulting terms together into the final polynomial. So not much then...
...and hopefully done quicker than a couple of months...

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!