2013-04-27
A Temporary Interruption to Service
2013-03-12
SICP Exercise 2.96: Pseudo-Remainder Terms
- Implement the procedure
pseudoremainder-terms, which is just likeremainder-termsexcept that it multiplies the dividend by the integerizing factor described above before callingdiv-terms. Modifygcd-termsto usepseudoremainder-terms, and verify thatgreatest-common-divisornow produces an answer with integer coefficients on the example in exercise 2.95. - The GCD now has integer coefficients, but they are larger than those of P1. Modify
gcd-termsso that it removes common factors from the coefficients of the answer by dividing all the coefficients by their (integer) greatest common divisor.
Part A: Introducing the Integerizing Factor
pseudoremainder-terms are described in the book as follows:
div-terms algorithm without introducing any fractions. The operation of multiplying the dividend by this constant and then dividing is sometimes called the pseudodivision of P by Q. The remainder of the division is called the pseudoremainder.
integer value so that it can be used as the exponent.
integer. As a result we can be pragmatic here and define the exponent operation for the integer package only. While defining it for the rational and real packages would be straightforward, this allows us to avoid having to define a generic logarithm operation in order to support complex numbers, as well as avoiding the complexities of calculating exponents for polynomial types.
integer implementation using the fast-expt implementation given in section 1.2.4 of the book. However, I chose simply to delegate the calculation to Scheme's built-in expt procedure:
(put 'exponent '(integer integer) (lambda (x y) (tag (expt x y))))
exponent operation in the usual manner:
(define (exponent b e) (apply-generic 'exponent b e))
pseudoremainder-terms. This will still call through to div-terms and return the cadr of the results as before. However, we need to apply the integerizing factor to the first term-list and then apply div-terms to divide the resulting term-list by second term-list. As noted above, the result of the calculation 1 + O1 - O2 needs converted to a tagged integer type using make-integer in order that it can be used as the exponent when applying the generic exponent operation. In the implementation below we then convert this integerizing factor to a zero-order term in order that we can use our existing mul-term-by-all-terms procedure to apply the factor to the first term-list. Here's the code:
(define (pseudoremainder-terms L1 L2)
(let* ((t1 (first-term L1))
(t2 (first-term L2))
(factor (exponent (coeff t2)
(make-integer (+ 1 (order t1) (- (order t2))))))
(pseudoL1 (mul-term-by-all-terms (make-term 0 factor) L1)))
(cadr (div-terms pseudoL1 L2))))
gcd-terms to use pseudoremainder-terms instead of remainder-terms and we're done:
(define (gcd-terms L1 L2)
(if (empty-termlist? L2)
L1
(gcd-terms L2 (pseudoremainder-terms L1 L2))))
q1 and q2, and calculating their GCD gave the following result:
> (greatest-common-divisor q1 q2)
(polynomial x dense-terms (rational (integer . 18954) integer . 2197)
(rational (integer . -37908) integer . 2197)
(rational (integer . 1458) integer . 169))
pseudoremainder-terms we now get the following result:
> (greatest-common-divisor q1 q2) (polynomial x dense-terms (integer . 1458) (integer . -2916) (integer . 1458))
Part B: Removing Common Factors
gcd-terms so that we simplify the calculated GCD as much as possible. If we assume we have a procedure, remove-common-factors, which does this then our gcd-terms implementation becomes:
(define (gcd-terms L1 L2)
(if (empty-termlist? L2)
(remove-common-factors L1)
(gcd-terms L2 (pseudoremainder-terms L1 L2))))
remove-common-factors need to do? Well firstly it will need to determine the highest common factor (a.k.a. the GCD) of all of the coefficients and then it will need produce a new term-list by dividing each of the coefficients in the term-list by this common factor.
(define (find-gcd c L)
(if (empty-termlist? L)
c
(find-gcd (greatest-common-divisor c (coeff (first-term L)))
(rest-terms L))))
remove-common-factors. As an empty term-list with its common factors removed is just an empty term-list we won't even need to invoke find-gcd in such a case. This provides a basic skeleton for our implementation of remove-common-factors: we determine whether we're dealing with an empty term-list, returning an empty term-list if we are and actually performing the removal if we're not. Here's the skeleton:
(define (remove-common-factors L)
(if (empty-termlist? L)
L
<RemoveCommonFactors>))
find-gcd to determine the GCD of the coefficients and then divide all of the coefficients by this GCD. One way of achieving this division would be to write a procedure that iterates through the term-list, applying the division to each coefficient and building a new term-list with the results. However, we already have a method of dividing a term-list by another value: div-terms, so it makes sense to use that instead. Unfortunately div-terms requires a term-list as the divisor, and find-gcd produces a tagged integer value, not a term-list. This means we'll need to first convert our tagged integer value into a zero-order term-list. We can do this by creating an empty termlist (with the-empty-termlist), creating a zero-order term with the GCD of the coefficients as its coefficient, and then adding this term to the empty term-list (with adjoin-term). Note that the division is guaranteed to produce no remainder, so we can simply return the calculated quotient as the simplified GCD.
remove-common-factors:
(define (remove-common-factors L)
(if (empty-termlist? L)
L
(let* ((gcd-coeff (find-gcd (coeff (first-term L)) (rest-terms L)))
(divisor (adjoin-term (make-term 0 gcd-coeff) (the-empty-termlist))))
(car (div-terms L divisor)))))
q1 and q2 again:
> (greatest-common-divisor q1 q2) (polynomial x dense-terms (integer . 1) (integer . -2) (integer . 1))
gcd-poly to reduce rational functions to their simplest terms.
2013-02-28
SICP Exercise 2.95: GCD and Non-Integer Values
P1: x2 - 2x + 1 P2: 11x2 + 7 P3: 13x + 5Now define Q1 to be the product of P1 and P2 and Q2 to be the product of P1 and P3, and use
greatest-common-divisor (exercise 2.94) to compute the GCD of Q1 and Q2. Note that the answer is not the same as P1. This example introduces noninteger operations into the computation, causing difficulties with the GCD algorithm. To understand what is happening, try tracing gcd-terms while computing the GCD or try performing the division by hand.
p1, p2 and p3 respectively:
> (define p1 (make-polynomial-from-coeffs 'x
(list (make-integer 1)
(make-integer -2)
(make-integer 1))))
> (define p2 (make-polynomial-from-coeffs 'x
(list (make-integer 11)
zero
(make-integer 7))))
> (define p3 (make-polynomial-from-coeffs 'x
(list (make-integer 13)
(make-integer 5))))
q1 and q2 respectively:
> (define q1 (mul p1 p2))
> (define q2 (mul p1 p3))
> q1
(polynomial x dense-terms (integer . 11)
(integer . -22)
(integer . 18)
(integer . -14)
(integer . 7))
> q2
(polynomial x dense-terms (integer . 13)
(integer . -21)
(integer . 3)
(integer . 5))
> (greatest-common-divisor q1 q2)
(polynomial x dense-terms (rational (integer . 18954) integer . 2197)
(rational (integer . -37908) integer . 2197)
(rational (integer . 1458) integer . 169))
(18954/2197)x2 - (37908/2197)x + 1458/169 = ((18954/13)/(2197/13))x2 - ((37908/13)/(2197/13))x + 1458/169 = (1458/169)x2 - (2916/169)x + 1458/169
((1458/169)x2 - (2916/169)x + 1458/169) * (169/1458) = ((1458*169)/(169*1458))x2 - ((2916*169)/(169*1458))x + (1458*169)/(169*1458) = ((1458*169)/(169*1458))x2 - ((2916*169)/(169*1458))x + (1458*169)/(169*1458) = (246402/246402)x2 - (492804/246402)x + 246402/246402 = x2 - 2x + 1 = P1
trace procedure, which takes a procedure as an argument and turns on tracing of all calls to that passed procedure. However, I found this to be limited in use: when a trace output line is "too long" it arbitrarily collapses each argument passed to the procedure to "#". This is obviously no use for what we'd like to achieve here. As a result, I quickly hacked a trace directly into the procedures gcd-terms and div-terms so that I could get a better picture of what's going on.
> (greatest-common-divisor q1 q2)
gcd-terms:
+-> (dense-terms (integer . 11)
| (integer . -22)
| (integer . 18)
| (integer . -14)
| (integer . 7))
+-> (dense-terms (integer . 13)
| (integer . -21)
| (integer . 3)
| (integer . 5))
| div-terms:
| +-> (dense-terms (integer . 11)
| | (integer . -22)
| | (integer . 18)
| | (integer . -14)
| | (integer . 7))
| +-> (dense-terms (integer . 13)
| | (integer . -21)
| | (integer . 3)
| | (integer . 5))
| | div-terms:
| | +-> (dense-terms (rational (integer . -55) integer . 13)
| | | (rational (integer . 201) integer . 13)
| | | (rational (integer . -237) integer . 13)
| | | (integer . 7))
| | +-> (dense-terms (integer . 13)
| | | (integer . -21)
| | | (integer . 3)
| | | (integer . 5))
| | | div-terms:
| | | +-> (sparse-terms (term 2 (rational (integer . 18954) integer . 2197))
| | | | (term 1 (rational (integer . -37908) integer . 2197))
| | | | (term 0 (rational (integer . 1458) integer . 169)))
| | | +-> (dense-terms (integer . 13)
| | | | (integer . -21)
| | | | (integer . 3)
| | | | (integer . 5))
| | | +-= ((sparse-terms)
| | | (sparse-terms (term 2 (rational (integer . 18954) integer . 2197))
| | | (term 1 (rational (integer . -37908) integer . 2197))
| | | (term 0 (rational (integer . 1458) integer . 169))))
| | +-= ((sparse-terms (term 0 (rational (integer . -55) integer . 169)))
| | (sparse-terms (term 2 (rational (integer . 18954) integer . 2197))
| | (term 1 (rational (integer . -37908) integer . 2197))
| | (term 0 (rational (integer . 1458) integer . 169))))
| +-= ((sparse-terms (term 1 (rational (integer . 11) integer . 13))
| (term 0 (rational (integer . -55) integer . 169)))
| (sparse-terms (term 2 (rational (integer . 18954) integer . 2197))
| (term 1 (rational (integer . -37908) integer . 2197))
| (term 0 (rational (integer . 1458) integer . 169))))
| gcd-terms:
| +-> (dense-terms (integer . 13)
| | (integer . -21)
| | (integer . 3)
| | (integer . 5))
| +-> (sparse-terms (term 2 (rational (integer . 18954) integer . 2197))
| | (term 1 (rational (integer . -37908) integer . 2197))
| | (term 0 (rational (integer . 1458) integer . 169)))
| | div-terms:
| | +-> (dense-terms (integer . 13)
| | | (integer . -21)
| | | (integer . 3)
| | | (integer . 5))
| | +-> (sparse-terms (term 2 (rational (integer . 18954) integer . 2197))
| | | (term 1 (rational (integer . -37908) integer . 2197))
| | | (term 0 (rational (integer . 1458) integer . 169)))
| | | div-terms:
| | | +-> (dense-terms (rational (integer . 208209690) integer . 41641938)
| | | | (rational (integer . -32032260) integer . 3203226)
| | | | (integer . 5))
| | | +-> (sparse-terms (term 2 (rational (integer . 18954) integer . 2197))
| | | | (term 1 (rational (integer . -37908) integer . 2197))
| | | | (term 0 (rational (integer . 1458) integer . 169)))
| | | | div-terms:
| | | | +-> (sparse-terms)
| | | | +-> (sparse-terms (term 2 (rational (integer . 18954) integer . 2197))
| | | | | (term 1 (rational (integer . -37908) integer . 2197))
| | | | | (term 0 (rational (integer . 1458) integer . 169)))
| | | | +-= ((sparse-terms)
| | | | (sparse-terms))
| | | +-= ((sparse-terms (term 0 (rational (integer . 457436688930)
| | | integer . 789281292852)))
| | | (sparse-terms))
| | +-= ((sparse-terms (term 1 (rational (integer . 28561) integer . 18954))
| | (term 0 (rational (integer . 457436688930)
| | integer . 789281292852)))
| | (sparse-terms))
| | gcd-terms:
| | +-> (sparse-terms (term 2 (rational (integer . 18954) integer . 2197))
| | | (term 1 (rational (integer . -37908) integer . 2197))
| | | (term 0 (rational (integer . 1458) integer . 169)))
| | +-> (sparse-terms)
| | +-= (sparse-terms (term 2 (rational (integer . 18954) integer . 2197))
| | (term 1 (rational (integer . -37908) integer . 2197))
| | (term 0 (rational (integer . 1458) integer . 169)))
| +-= (sparse-terms (term 2 (rational (integer . 18954) integer . 2197))
| (term 1 (rational (integer . -37908) integer . 2197))
| (term 0 (rational (integer . 1458) integer . 169)))
+-= (sparse-terms (term 2 (rational (integer . 18954) integer . 2197))
(term 1 (rational (integer . -37908) integer . 2197))
(term 0 (rational (integer . 1458) integer . 169)))
(polynomial x dense-terms (rational (integer . 18954) integer . 2197)
(rational (integer . -37908) integer . 2197)
(rational (integer . 1458) integer . 169))
div-terms by gcd-terms (via remainder-terms) makes a recursive call to itself. The fraction first enters the calculations when div-terms calculates the coefficient to use for the first term of the result. This is calculated by dividing the coefficient of the highest-order term from the first term-list by the coefficient of the highest-order term from the second term-list. Provided the latter is a factor of the former we will avoid non-integer values entering the computation. However in this case the coefficients are 11 and 13 respectively which, being prime numbers, are relatively prime to each other and so share no factors. Not only does this mean the coefficient of the first term of the result will be non-integer, but it also affects the calculations of both the coefficients for the other terms in the result and the remainder.
div-terms. In the next exercise we'll address this by first implementing a procedure which calculates pseudo-remainders, which guarantees that no non-integer coefficents will result from the calculation, and then incorporating this into our gcd-terms implementation.
2013-02-25
SICP Exercise 2.94: A Generic GCD
div-terms, implement the procedure remainder-terms and use this to define gcd-terms as above. Now write a procedure gcd-poly that computes the polynomial GCD of two polys. (The procedure should signal an error if the two polys are not in the same variable.) Install in the system a generic operation greatest-common-divisor that reduces to gcd-poly for polynomials and to ordinary gcd for ordinary numbers. As a test, try
(define p1 (make-polynomial 'x '((4 1) (3 -1) (2 -2) (1 2)))) (define p2 (make-polynomial 'x '((3 1) (1 -1)))) (greatest-common-divisor p1 p2)and check your result by hand.
Calculating the GCD of Polynomials
div-terms was introduced back in exercise 2.91 and returns a list of the quotient term-list and the remainder term-list. As a result the implementation of remainder-terms is very straightforward. It just needs to extract and return the second item from the list returned by div-terms:
(define (remainder-terms L1 L2) (cadr (div-terms L1 L2)))
gcd-terms supplied in the book (I've renamed the parameters a and b to L1 and L2 respectively to match the convention used in our rational package):
(define (gcd-terms L1 L2)
(if (empty-termlist? L2)
L1
(gcd-terms L2 (remainder-terms L1 L2))))
gcd-poly for polynomials which raises an error if the polynomials have different indeterminates. This requires that we first check that the indeterminates match, raising the error if they don't, invoking gcd-terms to determine the GCD of the two polynomials' term-lists, and then finally creating a new polynomial with the same indeterminate as the two original polynomials and with the GCD as its term-list.
rational package, we can't simply use eq? to compare the indeterminates and then take the indeterminate from the first polynomial as the one to create the resulting polynomial in. Back in exercise 2.90 we introduced the concept of the unbound indeterminate in order to allow us to handle type conversions correctly. This requires that an unbound polynomial is considered to match the indeterminate of any other polynomial. In order to achieve this we also introduced the procedures same-variable? and select-variable, which cope with the unbound indeterminate. As a result, we must implement gcd-poly in terms of these procedures. Other than this the implementation is straightforward:
(define (gcd-poly p1 p2)
(let ((v1 (variable p1))
(v2 (variable p2)))
(if (same-variable? v1 v2)
(make-poly (select-variable v1 v2)
(gcd-terms (term-list p1) (term-list p2)))
(error (list "Polynomials must have same indeterminate to calculate GCD"
p1
p2)))))
polynomial package in the usual manner:
(put 'gcd '(polynomial polynomial)
(lambda (p1 p2) (tag (gcd-poly p1 p2))))
Calculating the GCD of Ordinary Numbers
greatest-common-divisor operation should reduce to ordinary gcd for "ordinary numbers". Of course we have slowly been building up our type system over the last several exercises. As a result it now supports several different numerical types: integers, rationals, reals and complex numbers. However, the GCD algorithm is only really defined for integers, so is not applicable to any but the first of these. As a result, we can restrict "ordinary numbers" to be integers, and so only need to deal with the integer package here.
integer package, and then install this procedure, tagging its results:
(define (gcd a b)
(if (= b 0)
a
(gcd b (remainder a b))))
(put 'gcd '(integer integer)
(lambda (x y) (tag (gcd x y))))
Adding a Generic GCD Operation
integer and polynomial types, greatest-common-divisor can be implemented as a normal generic operation, invoking apply-generic:
(define (greatest-common-divisor a b) (apply-generic 'gcd a b))
integer or polynomial will, of course, fail. In this respect our implementation corresponds pretty close to the Scheme interpreter I'm using:
> (gcd 3.4 2.3)
In standard input:
10: 0* [gcd {3.4} 2.3]
In .../section-2.5.3/base-definitions.scm:
9: 1 (if (= b 0) a (gcd b (remainder a b)))
11: 2 [gcd 2.3 ...
11: 3* [remainder {3.4} 2.3]
.../section-2.5.3/base-definitions.scm:11:14:
In procedure remainder in expression (remainder a b):
.../section-2.5.3/base-definitions.scm:11:14:
Wrong type argument in position 1: 3.4
ABORT: (wrong-type-arg)
Backtrace:
> (greatest-common-divisor (make-real 3.4) (make-real 2.3))
In standard input:
11: 0* [greatest-common-divisor (real . 3.4) (real . 2.3)]
In .../section-2.5.3/sicp-2.94.scm:
685: 1 [apply-generic gcd (real . 3.4) (real . 2.3)]
In .../section-2.5.3/base-apply-generic.scm:
...
73: 2 (let* ((result #)) (if (in-tower? result) (drop result) result))
73: 3* [find-and-apply-op]
59: 4 (let* ((type-tags #) (proc #)) (if proc (apply proc #) (if # #)))
...
70: 5 [error "No method for these types -- APPLY-GENERIC" (gcd (real real))]
.../section-2.5.3/base-apply-generic.scm:70:21:
In procedure error in expression
(error "No method for these types -- APPLY-GENERIC"
list op type-tags)):
.../section-2.5.3/base-apply-generic.scm:70:21:
No method for these types -- APPLY-GENERIC (gcd (real real))
Backtrace:
Putting It to the Test
> (define p1 (make-polynomial-from-coeffs 'x
(list (make-integer 1)
(make-integer -1)
(make-integer -2)
(make-integer 2)
zero)))
> (define p2 (make-polynomial-from-coeffs 'x
(list (make-integer 1)
zero
(make-integer -1)
zero)))
> (greatest-common-divisor p1 p2)
(polynomial x sparse-terms (term 2 (integer . -1))
(term 1 (integer . 1)))
GCD(x4 - x3 - 2x2 + 2x, x3 - x) = -x2 + x
p1 and p2,then compare the calculated GCD to the calculated quotients to ensure that the former is "greater" than the latter in both cases and, finally, to ensure that the calculated quotients are prime relative to each other. We can do the first step by applying div twice, with the calculated GCD as the divisor in both cases, but with p1 as the dividend in the first instance and p2 in the second:
> (div p1 (greatest-common-divisor p1 p2))
((polynomial x sparse-terms (term 2 (rational (integer . 1) integer . -1))
(term 0 (rational (integer . -2) integer . -1)))
(integer . 0))
> (div p2 (greatest-common-divisor p1 p2))
((polynomial x dense-terms (rational (integer . 1) integer . -1)
(integer . -1))
(integer . 0))
p1 and p2 as, in both cases, the remainder is equal to zero. We can also see that, in both cases, the calculated GCD is "greater" than the calculated quotient:
- In the case of
p1the calculated GCD and quotient are both second-order polynomials, but the calculated GCD has a higher coefficient for the first term where the coefficients differ. While both have a coefficient of -1 for the second-order term, the GCD has a coefficient of 1 for the first-order term while the calculated quotient has a coefficient of 0. - In the case of
p2, the calculated quotient is a lower-order polynomial than the GCD. The calculated quotient is first-order, while the calculated GCD is second-order.
> (greatest-common-divisor (car (div p1 (greatest-common-divisor p1 p2)))
(car (div p2 (greatest-common-divisor p1 p2))))
(integer . 1)
Addendum: A Simpler gcd-poly
coerce-and-call, which ensures that two polynomials are expressed in the same variable and then later expanded it so that we ensured that polynomials were expressed in canonical form. This approach allows us to entirely remove the test of the indeterminates from gcd-poly, giving the following implementation:
(define (gcd-poly p1 p2)
(make-poly (select-variable-from-polys p1 p2)
(gcd-terms (term-list p1) (term-list p2))))
(put 'gcd '(polynomial polynomial)
(lambda (p1 p2) (tag (coerce-and-call p1 p2 gcd-poly))))
2013-02-20
SICP Exercise 2.93: Rational Functions
make-rat so that it does not attempt to reduce fractions to lowest terms. Test your system by calling make-rational on two polynomials to produce a rational function
(define p1 (make-polynomial 'x '((2 1)(0 1)))) (define p2 (make-polynomial 'x '((3 1)(0 1)))) (define rf (make-rational p2 p1))
rf to itself, using add. You will observe that this addition procedure does not reduce fractions to lowest terms.
rational package implementation:
(define (install-rational-package)
;; internal procedures
(define (numer x) (car x))
(define (denom x) (cdr x))
(define (make-rat n d)
(if (and (integer? n) (integer? d))
(let ((g (gcd n d)))
(cons (/ n g) (/ d g)))
(error "non-integer numerator or denominator"
(list n d))))
(define (add-rat x y)
(make-rat (+ (* (numer x) (denom y))
(* (numer y) (denom x)))
(* (denom x) (denom y))))
(define (sub-rat x y)
(make-rat (- (* (numer x) (denom y))
(* (numer y) (denom x)))
(* (denom x) (denom y))))
(define (mul-rat x y)
(make-rat (* (numer x) (numer y))
(* (denom x) (denom y))))
(define (div-rat x y)
(make-rat (* (numer x) (denom y))
(* (denom x) (numer y))))
(define (equ? x y)
(and (= (numer x) (numer y))
(= (denom x) (denom y))))
(define (=zero? x) (= (numer x) 0))
(define (addd x y z)
(make-rat (+ (* (numer x) (denom y) (denom z))
(* (denom x) (numer y) (denom z))
(* (denom x) (denom y) (numer z)))
(* (denom x) (denom y) (denom z))))
(define (rational->real r) (make-real (/ (numer r) (denom r))))
(define (rational->integer r) (make-integer (round (/ (numer r) (denom r)))))
(define (sqrt-rat x)
(let ((root (sqrt (/ (numer x) (denom x)))))
(make-complex-from-real-imag (make-real (real-part root))
(make-real (imag-part root)))))
(define (square-rat x)
(mul-rat x x))
(define (arctan-rat x y)
(atan (/ (numer x) (denom x))
(/ (numer y) (denom y))))
(define (cosine-rat x)
(cos (/ (numer x) (denom x))))
(define (sine-rat x)
(sin (/ (numer x) (denom x))))
(define (negate-rat x)
(make-rat (- (numer x)) (denom x)))
;; interface to rest of the system
(define (tag x) (attach-tag 'rational x))
(put 'add '(rational rational)
(lambda (x y) (tag (add-rat x y))))
(put 'sub '(rational rational)
(lambda (x y) (tag (sub-rat x y))))
(put 'mul '(rational rational)
(lambda (x y) (tag (mul-rat x y))))
(put 'div '(rational rational)
(lambda (x y) (tag (div-rat x y))))
(put 'equ? '(rational rational) equ?)
(put '=zero? '(rational) =zero?)
(put 'addd '(rational rational rational)
(lambda (x y z) (tag (addd x y z))))
(put 'sqrt '(rational)
(lambda (x) (make-real (sqrt-rat x))))
(put 'square '(rational)
(lambda (x) (tag (square-rat x))))
(put 'arctan '(rational rational)
(lambda (x y) (make-real (arctan-rat x y))))
(put 'cosine '(rational)
(lambda (x) (make-real (cosine-rat x))))
(put 'sine '(rational)
(lambda (x) (make-real (sine-rat x))))
(put 'negate '(rational)
(lambda (x) (tag (negate-rat x))))
(put 'make 'rational
(lambda (n d) (tag (make-rat n d))))
(put-coercion 'rational 'real rational->real)
(put-coercion 'rational 'integer rational->integer)
'done)
(define (make-rational n d)
((get 'make 'rational) n d))
rational package was first introduced. As a result it's not simply a case of doing a find-and-replace, mapping the primitive operations of +, -, * and / to their generic equivalents of add, sub, mul and div, although that does form part of the modifications.
Rational Representation
numer and denom remain unchanged. However, we do need to modify the creation of the rational representation provided by make-rat:
- In order to produce mathematically correct rational numbers,
make-ratcurrently restricts us to constructing rational representations using primitive integer numerator and denominator values. Extending therationalpackage so that it can also be used to represent rational functions requires us to allow polynomials as well. We're doing this by modifying the package so that it uses tagged types for its numerator and denominator. However, while we'll now accept tagged types, in order to ensure mathematical correctness we should ensure that the numerator and denominator are restricted tointegerorpolynomialtypes. - The
integerandrealpackages include procedures for performing type conversions to therationaltype (i.e.integer->rationalandreal->rationalrespectively). Both invokemake-rationalas part of their type conversion, and pass in primitive integer values. If we're going to modify therationalpackage to use tagged types and generic operations then our changes need to account for these type conversion procedures. One approach would be to modify theinteger->rationalandreal->rationalprocedures so that they pass taggedintegervalues tomake-rational. However, we can limit the scope of our changes to therationalpackage alone if, in addition tointegerandpolynomialtagged types, we also accept primitive integers as the numerator and/or denominator formake-ratand havemake-ratautomatically convert them to taggedintegertypes. To do this we simply use acondinmake-rat, with the predicates in the first two clauses testing respectively whether the numerator or the denominator is a primitive integer, creating a taggedintegerand recursively calling with the tagged value if the predicate matches.
(define (numer x) (car x))
(define (denom x) (cdr x))
(define (valid-component? c)
(memq (type-tag c) '(integer polynomial)))
(define (make-rat n d)
(cond ((integer? n) (make-rat (make-integer n) d))
((integer? d) (make-rat n (make-integer d)))
((and (valid-component? n) (valid-component? d)) (cons n d))
(else (error
"numerator and denominator must both be integer or polynomial types"
(list n d)))))
valid-component? here which checks whether a value is tagged as an integer or polynomial. This is used by make-rat to perform the final validation of the types of the passed arguments once it's checked that any primitive integers have been wrapped.
Basic Arithmetic Operations
+ with add, - with sub and * with mul (the primitive division operation, /, is unused here):
(define (add-rat x y)
(make-rat (add (mul (numer x) (denom y))
(mul (numer y) (denom x)))
(mul (denom x) (denom y))))
(define (sub-rat x y)
(make-rat (sub (mul (numer x) (denom y))
(mul (numer y) (denom x)))
(mul (denom x) (denom y))))
(define (mul-rat x y)
(make-rat (mul (numer x) (numer y))
(mul (denom x) (denom y))))
(define (div-rat x y)
(make-rat (mul (numer x) (denom y))
(mul (denom x) (numer y))))
square-rat simply calls through to mul-rat without inspecting its argument, so it can remain unchanged:(define (square-rat x) (mul-rat x x))
equ?, =zero?, addd and negate-rat, which need only minor tweaks:- We can replace
=with a call to the genericequ?operation in theequ?procedure. Similarly, we can replace the comparison of the numerator with0in=zero?with a call to the generic=zero?on the numerator. However, as theserationaloperations have identical names to the generic operations, the globally scoped generic operations are obscured by therationalpackage's implementations. As a result, the interpreter will not invoke the global generic operations with these names but will instead recursively invoke therationalpackage's implementations, which will then fail as the passed values will not be of the correct type. To resolve this we'll rename the procedures within therationalpackage toequ-rat?and=zero-rat?respectively and change the correspondingputinvocations which install them appropriately. - Substituting
addandmulfor+and*respectively into the procedureaddd, which we built as part of exercise 2.82, will not work. The primitive operation*is used as a ternary operation in the current implementation ofaddd. However, our generic arithmetic operationaddis a binary operation. We can address this simply by converting the implementation ofadddto useadd-rattwice in succession: adding the first two arguments together first, which produces arationalresult, and then adding the third argument to the result of that. - Similarly, simply substituting
subfor-into the procedurenegate-ratwill not work. In this case-is currently used as a unary operation with the semantics that this negates the primitive integer value passed to it. However, our generic arithmetic operationsubis a binary operation. Fixing this is simpler than foraddd: we make the substitution, but we pass0as the first argument tosub, andxas the second (as 0 - n = -n).
(define (equ-rat? x y)
(and (equ? (numer x) (numer y))
(equ? (denom x) (denom y))))
(define (=zero-rat? x) (=zero? (numer x)))
(define (addd x y z)
(add-rat (add-rat x y) z))
(define (negate-rat x)
(make-rat (sub zero (numer x)) (denom x)))
…
(put 'equ? '(rational rational) equ-rat?)
(put '=zero? '(rational) =zero-rat?)
Type Conversion, Square Root and Trigonometric Operations
- The type conversion operations:
rational->realandrational->integer. - The square root operation:
sqrt-rat. - The trigonometric operations:
arctan-rat,cosine-ratandsine-rat.
- Applying these operations to polynomials is either complicated, or does not make sense. We can make our lives easier in this exercise if we state that we'll only support these operations for rational numbers; rational functions are not supported.
- When applied to
integer-tagged values these operations require access to the underlying primitive integer values in order that we can compute their values easily. This breaks the encapsulation of the tagged types but is necessary as all of the operations need to calculate the result of dividing the numerator by the denominator in order to apply a primitive operation to the result. Note that we can't simply usedivto calculate this as applyingdivto the two taggedintegervalues representing the numerator and denominator will just produce the original taggedrationalvalue we started with! We'll deal with resolving this problem below...
Avoiding the Issue: Using real Operations
sqrt-rat and the trigonometric operations first. Note that, while implementing these directly for rational numbers involves breaking encapsulation, no such problem arises if we first raise a rational number to a real number, and then delegate the calculation to that package! As a result, each of these operations can be achieved by:
- Validating that the parameter(s) to the operation are rational numbers and not rational functions
(i.e. both the numerator and denominator are
integers). - Raising the
rationalnumbers torealnumbers. Of course we'll need to re-tag therationalnumbers as such before attempting this, otherwiseraisewon't know what type of number it's dealing with! Note that, assuming we fix our type conversion operations, thisraisewill be guaranteed to succeed and result in arealnumber. - Applying the corresponding generic operation (e.g.
square-rootforsqrt-rat, and so on). The generic operations will then apply the implementations defined forrealnumbers and so avoid us having to implement them directly!
rationals in a list are rational numbers, with integer numerators and denomniators, as follows:
(define (all-rational-numbers? rs)
(cond ((null? rs) true)
((and (eq? 'integer (type-tag (numer (car rs))))
(eq? 'integer (type-tag (denom (car rs)))))
(all-rational-numbers? (cdr rs)))
(else false)))
rationals to apply it to, tests that they are all rational numbers, tags and raises the rationals and finally applies the generic operation using apply as follows:
(define (apply-as-real-if-all-rational-numbers f rs)
(if (all-rational-numbers? rs)
(apply f (map raise (map tag rs)))
(error (list "numerator and denominator must both be integer to apply " f))))
sqrt-rat and the trigonometric operations to utilize this procedure, and to change the installation of these procedures via put. The latter is necessary as the results of apply-as-real-if-all-rational-numbers will be a valid tagged value if it succeeds, so there's no need to turn the results into a real number anymore. This allows us to remove the wrapping λ-functions here:
(define (sqrt-rat x) (apply-as-real-if-all-rational-numbers square-root (list x))) (define (arctan-rat x y) (apply-as-real-if-all-rational-numbers arctan (list x y))) (define (cosine-rat x) (apply-as-real-if-all-rational-numbers cosine (list x))) (define (sine-rat x) (apply-as-real-if-all-rational-numbers sine (list x))) … (put 'sqrt '(rational) sqrt-rat) (put 'arctan '(rational rational) arctan-rat) (put 'cosine '(rational) cosine-rat) (put 'sine '(rational) sine-rat)
Type Conversion and Breaking Encapsulation
rational->real and rational->integer. While we're only going to support rational numbers here, it's pretty much impossible to avoid the stumbling block that in order to perform these conversions we need to understand the internal representation of the integer type from within the rational package in order that we can perform the primitive division necessary to support the type conversion. I.e. we end up breaking the encapsulation.
to-primitive, which converts a rational representing a rational number into its equivalent Scheme primitive numerical value. This restricts the breakage to this procedure alone. The two type conversion operations invoke this, blissfully unaware of the issue, and do not need to access the internals of the numerator and denominator in order to perform the division themselves. Note that to-primitive returns 0 if either the numerator or denominator is a polynomial. This is to allow the existing drop behaviour to continue function correctly - if it's not possible to perform a conversion then the value remains unchanged.
(define (to-primitive x)
(let ((n (numer x))
(d (denom x)))
(if (and (eq? 'integer (type-tag n)) (eq? 'integer (type-tag d)))
(/ (contents n) (contents d))
0)))
(define (rational->real r)
(make-real (to-primitive r)))
(define (rational->integer r)
(make-integer (round (to-primitive r))))
Rational Functions In Action
> (define p1 (make-polynomial-from-coeffs 'x
(list (make-integer 1)
zero
(make-integer 1))))
> (define p2 (make-polynomial-from-coeffs 'x
(list (make-integer 1)
zero
zero
(make-integer 1))))
> (define rf (make-rational p2 p1))
> (add rf rf)
(rational (polynomial x sparse-terms (term 5 (integer . 2))
(term 3 (integer . 2))
(term 2 (integer . 2))
(term 0 (integer . 2)))
polynomial x sparse-terms (term 4 (integer . 1))
(term 2 (integer . 2))
(term 0 (integer . 1)))
> (define r1 (make-rational 10 3)) > (define r2 (make-rational 3 4)) > (add r1 r2) (rational (integer . 49) integer . 12) > (sub r1 r2) (rational (integer . 31) integer . 12) > (mul r1 r2) (rational (integer . 30) integer . 12) > (div r1 r2) (rational (integer . 40) integer . 9) > (equ? r1 r2) #f > (equ? r1 r1) #t > (=zero? r1) #f > (=zero? (make-rational zero 4)) #t > (addd r1 r1 r1) (rational (integer . 270) integer . 27) > (square r2) (rational (integer . 9) integer . 16) > (square-root (square r2)) (rational (integer . 3) integer . 4) > (negate r1) (rational (integer . -10) integer . 3)
> (arctan r1 r2) (rational (integer . 3038763055969609) integer . 2251799813685248) > (exact->inexact (/ 3038763055969609 2251799813685248)) 1.34948188444711 > (atan 10/3 3/4) 1.34948188444711 > (cosine r2) (rational (integer . 6590467434422559) integer . 9007199254740992) > (exact->inexact (/ 6590467434422559 9007199254740992)) 0.731688868873821 > (cos 3/4) 0.731688868873821 > (sine r2) (rational (integer . 6139656131284749) integer . 9007199254740992) > (exact->inexact (/ 6139656131284749 9007199254740992)) 0.681638760023334 > (sin 3/4) 0.681638760023334
2013-02-14
Guess What?
Yep, I stalled again.
I've got a couple of excuses. No really I have.
First it was holiday season. The combination of Thanksgiving, Christmas and so on make things somewhat busy at my work. The spare time I normally spend doing this was diverted away to more work-related stuff. It was challenging-but-enjoyable stuff, but meant I couldn't make much progress on SICP.
Secondly my second child was born in December. If you've kids of your own you'll know just how much time a tiny baby can absorb!
Anyway, I'm starting to get back on track now. I've got a working implementation of exercise 2.93 which I'll try to write up and post over the next week or so. I'll also go back and make a minor correction to some of the recent work we've been doing as I realized I'd left in the support for the 'scheme-number tagged type (i.e. Scheme's numerical primitive types). This was somewhat messing up the work needed for 2.93 so I've stripped it out.
2012-09-07
SICP Exercise 2.92: Dealing With Different Indeterminates - The "This is Not Easy!" Approach - Part 2
Test Polynomials
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))))
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))))
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))))
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))))
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))))))
p6: 42x0
Canonical form: 42unbound0 = 42
(define p6 (make-polynomial-from-coeffs 'x (list (make-integer 42))))
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
- 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 - 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 - 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
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.
{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))
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))
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:- If the term's coefficient is itself a polynomial then recursively expand the coefficient. This produces an expansion using our intermediate representation.
- 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))). - 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)) - Finally, append the resulting expansion of this term onto the results of expanding the rest of the term-list.
(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))))))))
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.
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.
expand-poly:
(put 'expand-poly '(polynomial) expand-poly)
(define (expand-poly p) (apply-generic 'expand-poly p))
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))
{indeterminate, order} values. We'll sort this next...
Rearranging the Expansion
{indeterminate, order} values at this stage.
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.
{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.
(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)))))
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)
(define (rearrange-expansion e) ((get 'rearrange-expansion 'polynomial) e))
> (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
- 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
'unboundindeterminate and a zero-order term with the coefficient ofzero. - 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'unboundindeterminate and only a zero-order term. However, in this case we'll set the coefficient to the coefficient of the expanded term.
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)))))
to-collapsed-term-list, which we'll move onto now. You'll also note that our procedure for doing this takes four operands:
- 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.
- 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.
- 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.
- 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.
- 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.
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))))))))
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-expansiongenerates 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 thepolynomialpackage. 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-expansionthe 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'unboundwith a single zero-order term, we'll generate a non-polynomial value. I.e.zeroin 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.
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))))))
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))))
drops them to reduce them to simplest form:
(put 'to-canonical '(polynomial)
(lambda (p) (drop (tag (to-canonical-poly p)))))
(define (to-canonical p) (apply-generic 'to-canonical p))
> (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)
Integrating into the System
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!
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)))
> (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)