@comment(Hey, EMACS, this is -*- SCRIBE -*- input)
@device(dover)
@make(6001)

@modify(excounter, numbered [Exercise @1], referenced [@1])

@PageHeading(left "6.001 -- Hewlett-Packard Summer 1985",
             center "@Value(Page)",
             right "Problem set 5")

@begin(center)
HEWLETT-PACKARD
Summer 1985

Problem Set 5

Originally Prepared As

MASSACHUSETTS INSTITUTE OF TECHNOLOGY
Department of Electrical Engineering and Computer Science
6.001 Structure and Interpretation of Computer Programs
Spring Semester, 1985; Problem Set 5
@end(center)
@blankspace(0.25 in)

@b[Warning:] This assignment is considerably more difficult than the
previous ones.  You will be dealing with a much larger volume of code
than you have until now -- the complete generic arithmetic system
described in Section 2.4 of the text.  Not only is the system
massive, but it is also ``sophisticated,'' making heavy use of
data-directed techniques.  This is your first assignment where the key
skill we will be working on is the ability to deal with a large
system, assimilating its organization, without being overwhelmed.  The
upshot of all this is that you should be sure to study Sections 2.3
and 2.4 of the text, and carefully read and think about this handout
before actually attempting to write any code.  The key to this problem
set is understanding the organization well enough to know what you
need to understand and what you need not understand.  Don't be afraid
to ask for help.

@begin(center)
@b[Exercises]
@end(center)

Write up and turn in the following exercises from Chapter 2 of
the text:

@begin(itemize)
Exercise 2.47

Exercise 2.50.  This will be especially helpful in
preparing to do the programming assignment.
@end(itemize)

@blankspace(0.25 in)

@begin(center)
@b[Programming assignment]

@b[Rational Functions]
@end(center)

This assignment is based on pages 162 through 166 of the text, which
ask you to implement a system for dealing with rational functions
(quotients of polynomials).

Here are the pieces of the generic arithmetic system that will be
loaded in for you to work with, (the full code is attached at the end):

@paragraph(The basic generic system)

We'll begin with a basic system for performing generic arithmetic
operations.  These are defined as follows:
@begin(programexample)
(define (add x y) (operate-2 'add x y))
(define (sub x y) (operate-2 'sub x y))
(define (mul x y) (operate-2 'mul x y))
(define (div x y) (operate-2 'div x y))
(define (=zero? x) (operate '=zero? x))
(define (negate x) (operate 'negate x))
@end(programexample)

Using these we can define compound generic operations, such as:
@begin(programexample)
(define (square x) (mul x x))
@end(programexample)

The basic @a[operate] mechanism is as described in sections 2.3.3 and
2.4.1:
@begin(programexample)
(define (operate op obj)
  (let ((proc (get (type obj) op)))
    (if (not (null? proc))   ;operator is defined on type
        (proc (contents obj))
        (error "Operator undefined on this type -- OPERATE"
               (list op obj)))))

(define (operate-2 op arg1 arg2)
  (let ((t1 (type arg1)))
    (if (eq? t1 (type arg2))
        (let ((proc (get t1 op)))
          (if (not (null? proc)) 
              (proc (contents arg1) (contents arg2))
              (error
               "Operator undefined on this type -- OPERATE-2"
               (list op arg1 arg2))))
        (error "Operands not of same type -- OPERATE-2"
               (list op arg1 arg2)))))
@end(programexample)
Notice that @a[operate-2] does not coerce between different types.  In
general, we won't worry about coercion in this assignment.

The table operations @a[put] and @a[get] are implemented using
the method described in section 3.3.3 of the text.  In keeping with our
notion of levels of abstraction, you
needn't worry about understanding this until we get to that section.
Just assume that @a[put] and @a[get] are available for you to use.

@paragraph(Ordinary numbers)

We'll begin by installing ordinary numbers in the system, as described
in section 2.4.1.

@begin(programexample)
(define (+number x y) (make-number (+ x y)))
(define (-number x y) (make-number (- x y)))
(define (*number x y) (make-number (* x y)))
(define (/number x y) (make-number (/ x y)))
(define (negate-number x) (make-number (- x)))
(define (=zero-number? x) (= x 0))

(define (make-number x) (attach-type 'number x))

(put 'number 'add +number)
(put 'number 'sub -number)
(put 'number 'mul *number)
(put 'number 'div /number)
(put 'number 'negate negate-number)
(put 'number '=zero? =zero-number?)
@end(programexample)

@paragraph(The bottom level type system)

Rather than using the type operations described on page 143, we make a
modification that allows us to represent ordinary numbers as Scheme
numbers.  For example, rather than having the number 5 represented as
a pair whose car is the type and whose cdr is 5,
we will be able to use 5 directly.  This idea is
discussed in exercise 2.49.

@begin(programexample)
(define (attach-type type contents)
  (if (and (eq? type 'number) (number? contents))
      contents
      (cons type contents)))

(define (type datum)
  (cond ((number? datum) 'number)
        ((not (atom? datum)) (car datum))
        (else (error "Bad typed datum -- TYPE" datum))))

(define (contents datum)
  (cond ((number? datum) datum)
        ((not (atom? datum)) (cdr datum))
        (else (error "Bad typed datum -- CONTENTS" datum))))
@end(programexample)

@paragraph(Polynomials)

Our arithmetic system also includes polynomials, using the
operations described in Section 2.4.3:
@begin(programexample)
(define (+poly p1 p2)
  (if (same-variable? (variable p1) (variable p2))
      (make-polynomial (variable p1)
                       (+terms (term-list p1)
                               (term-list p2)))
      (error "Polys not in same var -- +POLY" (list p1 p2))))

(define (*poly p1 p2)
  (if (same-variable? (variable p1) (variable p2))
      (make-polynomial (variable p1)
                       (*terms (term-list p1)
                               (term-list p2)))
      (error "Polys not in same var -- *POLY" (list p1 p2))))

(define (=zero-poly? p)
  (empty-termlist? (term-list p)))

(put 'polynomial 'add +poly)
(put 'polynomial 'mul *poly)
(put 'polynomial '=zero? =zero-poly?)
@end(programexample)

Polynomial operations are defined using operations on term lists:

@begin(programexample)
(define (+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
                               (+terms (rest-terms L1) L2)))
                 ((< (order t1) (order t2))
                  (adjoin-term t2
                               (+terms L1 (rest-terms L2))))
                 (else
                  (adjoin-term (make-term (order t1)
                                          (add (coeff t1)
                                               (coeff t2)))
                               (+terms (rest-terms L1)
                                       (rest-terms L2)))))))))

(define (*terms L1 L2)
  (if (empty-termlist? L1)
      (the-empty-termlist)
      (+terms (*-term-by-all-terms (first-term L1) L2)
              (*terms (rest-terms L1) L2))))

(define (*-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)))
                     (*-term-by-all-terms t1 (rest-terms L))))))

@end(programexample)

Term lists are represented as described beginning on page 158:
@begin(programexample)
(define (adjoin-term term term-list)
  (if (=zero? (coeff term))                ;slight simplification
      term-list
      (cons 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))

(define (make-term order coeff) (list order coeff))
(define (order term) (car term))
(define (coeff term) (cadr term))

(define (make-polynomial variable term-list)
  (attach-type 'polynomial (cons variable term-list)))

(define (variable p) (car p))
(define (term-list p) (cdr p))
(define (same-variable? v1 v2) (eq? v1 v2))
@end(programexample)

@paragraph(Rational numbers)

The final piece of our system is a rational number package like the
one described in section 2.1.1.  The difference is that the
arithmetic operations used to combine numerators and denominators are
@a[generic] operations, rather than the primitive @a[+], @a[-], and
@a[*].  This difference is important, because it allows us to work with
``rational numbers'' whose numerators and denominators are arbitrary
algebraic objects, rather than only numbers.  The situation is exactly
analogous to the way that using generic operations in @a[+terms] and
@a[*terms] enable us to work with polynomials with arbitrary
coefficients.


In implementing rational numbers, we will follow the same style that
we saw used in implementing complex numbers.  In particular, we will
create a set of procedures for operating on rationals within the
rational number package, and then create a set of interface procedures that
allow the generic arithmetic operations to work on rationals.

First, we define a set of procedures for manipulating rationals:
@begin(programexample)
(define (+rat x y)
  (make-rat (add (mul (numer x) (denom y))
                 (mul (denom x) (numer y)))
            (mul (denom x) (denom y))))

(define (-rat x y)
  (make-rat (sub (mul (numer x) (denom y))
                 (mul (denom x) (numer y)))
            (mul (denom x) (denom y))))

(define (*rat x y)
  (make-rat (mul (numer x) (numer y))
            (mul (denom x) (denom y))))

(define (/rat x y)
  (make-rat (mul (numer x) (denom y))
            (mul (denom x) (numer y))))

(define (negate-rat x)
  (make-rat (negate (numer x))
            (denom x)))

(define (=zero-rat? x)
  (=zero? (numer x)))

@end(programexample)

The representation of rational numbers is defined as follows:
@begin(programexample)
(define (make-rat n d) (cons n d))

(define (numer x) (car x))

(define (denom x) (cdr x))
@end(programexample)                          

Note that @a[make-rat] does not reduce rationals to
lowest terms, because @a[gcd] works only on integers
but we are allowing arbitrary numerators and denominators.

Now, we provide a set of interface procedures for
handling rationals, and install them in the table.

@begin(programexample)
(define (make-rational x)
   (attach-type 'rational x))

(define (+rational x y)
   (make-rational (+rat x y)))

(define (-rational x y)
   (make-rational (-rat x y)))

(define (*rational x y)
   (make-rational (*rat x y)))

(define (/rational x y)
   (make-rational (/rat x y)))

(define (negate-rational x)
   (make-rational (negate-rat x)))


(put 'rational 'add +rational)
(put 'rational 'sub -rational)
(put 'rational 'mul *rational)
(put 'rational 'div /rational)
(put 'rational 'negate negate-rational)
(put 'rational '=zero? =zero-rat?)

@end(programexample)
Note that we do not need to define @a[=zero-rational?].  Since it
would consist simply of a call to @a[=zero-rat?], we can use
@a[=zero-rat?] directly.

Finally, since our rational-number package has been set up to deal
with generic operations, we need a way of creating a rational number
composed of arbitrary parts:
@begin(programexample)
(define (create-rational x y)
   (make-rational (make-rat x y)))

@end(programexample)

@paragraph(Playing with the generic-arithmetic system)

All of the code above will be loaded into Scheme when you load the
files for problem set 5.  You will not need to edit any of this code.
We begin with a few simple exercises, to become acquainted with how
the system is used.

@b[Problem 1]: Produce expressions that define
@begin(alphaenumerate)
the rational number 7/12

the polynomial @a[x@+[5] + 3x@+[3] - 4x + 2]

the polynomial @a[(2/3)x@+[4] + (4/5)x@+[2] + (1/3)x + 1]
@end(alphaenumerate)
If your definitions are correct
you should be able to use the generic @a[square] operator to compute
the square of each of these items, and (for more excitement) the
square of the square of each.  Turn in the definitions you typed to
create these objects.

@paragraph(Completing the polynomial package)

If you construct a chart of the dispatch table we have been building,
you will see that there are some unfilled slots in it, dealing with
polynomials. The generic @a[negate], @a[sub], and @a[div] operations
do not know how to handle polynomials.

Hand in listings of all the procedures you write in the following
exercises.

@b[Problem 2]  Write a procedure @a[negate-poly] that negates all
the terms of a polynomial and install it in the table as
the generic @a[negate] operation on polynomials.

@b[Problem 3] Using the @a[negate-poly] procedure you created in
Problem 2, and the procedure @a[+poly], implement a polynomial
subtraction procedure @a[-poly], and install this as the generic
@a[sub] operation on polynomials.

@b[Problem 4:] Do exercise 2.63 on page 160 of the text.  Install the
procedure @a[/poly] in the table as the generic @a[div] operation
on polynomials.
To test your program, try
@begin(programexample)
(define p1
  (make-polynomial 'x
                   '((10 1) (9 1) (8 -3) (2 -1) (1 -1) (0 3))))
(define p2 (make-polynomial 'x '((8 1) (0 -1))))
(div p1 p2)
@end(programexample)
What answer do you get?

@paragraph(Polynomial GCDs)

As we have
noted, our @a[make-rat] procedure does not reduce the rational number to
lowest terms.  To see this, try the following example:

@begin(programexample)

(define p1 (make-polynomial 'x '((2 1) (0 1))))
(define p2 (make-polynomial 'x '((3 1) (0 1))))
(define rf (create-rational p2 p1))

@end(programexample)

Now add @a[rf] to itself, using the generic @a[add].  You will observe
that this addition procedure does not reduce fractions to lowest
terms.  The remaining problems deal with handling this difficulty.
Read the discussion beginning on page 163 of the text.

@b[Problem 5:] Do exercise 2.66.

@b[Problem 6:] Do exercise 2.67.


@paragraph(The rest of this assignment is optional)

Do exercise 2.68.

Do the following modified exercise 2.69:  Write a @a[make-rat-poly]
procedure that is analogous to the original @a[make-rat] for integers
(p. 79 of the text) except that it uses the @a[reduce] procedure from
exercise 2.68 to reduce the numerator and the denominator to lowest
terms.  You can now easily obtain a system that handles rational
expresssions in either integers or polynomials by renaming
@a[make-rat] as @a[make-rat-number] and defining a new @a[make-rat] as
a generic operation that calls @a[operate-2] to dispatch to either 
@a[make-rat-poly] or @a[make-rat-number].  To be consistent, modify
@a[make-rat-number] to use @a[gcd] to reduce a rational number
composed of integers to lowest terms, similar to the version on page
79 of the text.  To test your program, try the
following example:

@begin(programexample)

(define p1 (make-polynomial 'x '((1 1) (0 1))))

(define p2 (make-polynomial 'x '((3 1) (0 -1))))

(define p3 (make-polynomial 'x '((1 1))))

(define p4 (make-polynomial 'x '((2 1) (0 -1))))

(define rf1 (create-rational p1 p2))

(define rf2 (create-rational p3 p4))

(add rf1 rf2)

@end(programexample)

See if you get the correct answer, correctly reduced to lowest terms.

@newpage()
@begin(programexample)

;;This is the file ps5-code.scm

; generic arithmetic operations

(define (add x y) (operate-2 'add x y))
(define (sub x y) (operate-2 'sub x y))
(define (mul x y) (operate-2 'mul x y))
(define (div x y) (operate-2 'div x y))
(define (=zero? x) (operate '=zero? x))
(define (negate x) (operate 'negate x))

; a sample compound generic operation

(define (square x) (mul x x))

; the operate mechanism.  Note that we don't deal with coercion here.

(define (operate op obj)
  (let ((proc (get (type obj) op)))
    (if (not (null? proc))   ;operator is defined on type
        (proc (contents obj))
        (error "Operator undefined on this type -- OPERATE"
               (list op obj)))))

(define (operate-2 op arg1 arg2)
  (let ((t1 (type arg1)))
    (if (eq? t1 (type arg2))
        (let ((proc (get t1 op)))
          (if (not (null? proc)) 
              (proc (contents arg1) (contents arg2))
              (error
               "Operator undefined on this type -- OPERATE-2"
               (list op arg1 arg2))))
        (error "Operands not of same type -- OPERATE-2"
               (list op arg1 arg2)))))


; code for creating the table, you don't need to worry about this.

(define (make-table)
  (let ((local-table (list '*table*)))

    (define (lookup key-1 key-2)
      (let ((subtable (assq key-1 (cdr local-table))))
        (if (null? subtable)
            nil
            (let ((record (assq key-2 (cdr subtable))))
              (if (null? record)
                  nil
                  (cdr record))))))

    (define (insert! key-1 key-2 value)
      (let ((subtable (assq key-1 (cdr local-table))))
        (if (null? subtable)
            (set-cdr! local-table
                      (cons (list key-1
                                  (cons key-2 value))
                            (cdr local-table)))
            (let ((record (assq key-2 (cdr subtable))))
              (if (null? record)
                  (set-cdr! subtable
                            (cons (cons key-2 value)
                                  (cdr subtable)))
                  (set-cdr! record value)))))
      'ok)

    (define (dispatch m)
      (cond ((eq? m 'lookup-proc) lookup)
            ((eq? m 'insert-proc!) insert!)
            (else (error "Unknown operation -- TABLE" m))))

    dispatch))

(define operation-table (make-table))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))


; procedures for dealing with ordinary numbers.

(define (+number x y) (make-number (+ x y)))
(define (-number x y) (make-number (- x y)))
(define (*number x y) (make-number (* x y)))
(define (/number x y) (make-number (/ x y)))
(define (negate-number x) (make-number (- x)))
(define (=zero-number? x) (= x 0))

(define (make-number x) (attach-type 'number x))

(put 'number 'add +number)
(put 'number 'sub -number)
(put 'number 'mul *number)
(put 'number 'div /number)
(put 'number 'negate negate-number)
(put 'number '=zero? =zero-number?)

; the bottom level typing system

(define (attach-type type contents)
  (if (and (eq? type 'number) (number? contents))
      contents
      (cons type contents)))

(define (type datum)
  (cond ((number? datum) 'number)
        ((not (atom? datum)) (car datum))
        (else (error "Bad typed datum -- TYPE" datum))))

(define (contents datum)
  (cond ((number? datum) datum)
        ((not (atom? datum)) (cdr datum))
        (else (error "Bad typed datum -- CONTENTS" datum))))


; procedures for dealing with polynomials

(define (+poly p1 p2)
  (if (same-variable? (variable p1) (variable p2))
      (make-polynomial (variable p1)
                       (+terms (term-list p1)
                               (term-list p2)))
      (error "Polys not in same var -- +POLY" (list p1 p2))))

(define (*poly p1 p2)
  (if (same-variable? (variable p1) (variable p2))
      (make-polynomial (variable p1)
                       (*terms (term-list p1)
                               (term-list p2)))
      (error "Polys not in same var -- *POLY" (list p1 p2))))

(define (=zero-poly? p)
  (empty-termlist? (term-list p)))

(put 'polynomial 'add +poly)
(put 'polynomial 'mul *poly)
(put 'polynomial '=zero? =zero-poly?)


; procedures for dealing with term lists

(define (+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
                               (+terms (rest-terms L1) L2)))
                 ((< (order t1) (order t2))
                  (adjoin-term t2
                               (+terms L1 (rest-terms L2))))
                 (else
                  (adjoin-term (make-term (order t1)
                                          (add (coeff t1)
                                               (coeff t2)))
                               (+terms (rest-terms L1)
                                       (rest-terms L2)))))))))

(define (*terms L1 L2)
  (if (empty-termlist? L1)
      (the-empty-termlist)
      (+terms (*-term-by-all-terms (first-term L1) L2)
              (*terms (rest-terms L1) L2))))

(define (*-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)))
                     (*-term-by-all-terms t1 (rest-terms L))))))


; procedures for representing term lists.

(define (adjoin-term term term-list)
  (if (=zero? (coeff term))                ;slight simplification
      term-list
      (cons 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))

(define (make-term order coeff) (list order coeff))
(define (order term) (car term))
(define (coeff term) (cadr term))

(define (make-polynomial variable term-list)
  (attach-type 'polynomial (cons variable term-list)))

(define (variable p) (car p))
(define (term-list p) (cdr p))
(define (same-variable? v1 v2) (eq? v1 v2))


; the rational arithmetic package
;
; these functions manipulate rationals within the package

(define (+rat x y)
  (make-rat (add (mul (numer x) (denom y))
                 (mul (denom x) (numer y)))
            (mul (denom x) (denom y))))

(define (-rat x y)
  (make-rat (sub (mul (numer x) (denom y))
                 (mul (denom x) (numer y)))
            (mul (denom x) (denom y))))

(define (*rat x y)
  (make-rat (mul (numer x) (numer y))
            (mul (denom x) (denom y))))

(define (/rat x y)
  (make-rat (mul (numer x) (denom y))
            (mul (denom x) (numer y))))

(define (negate-rat x)
  (make-rat (negate (numer x))
            (denom x)))

(define (=zero-rat? x)
  (=zero? (numer x)))

; procedures for representing rationals

(define (make-rat n d) (cons n d))

(define (numer x) (car x))

(define (denom x) (cdr x))


; procedures to interface rationals to other parts of the generic system

(define (make-rational x)
   (attach-type 'rational x))

(define (+rational x y)
   (make-rational (+rat x y)))

(define (-rational x y)
   (make-rational (-rat x y)))

(define (*rational x y)
   (make-rational (*rat x y)))

(define (/rational x y)
   (make-rational (/rat x y)))

(define (negate-rational x)
   (make-rational (negate-rat x)))


(put 'rational 'add +rational)
(put 'rational 'sub -rational)
(put 'rational 'mul *rational)
(put 'rational 'div /rational)
(put 'rational 'negate negate-rational)
(put 'rational '=zero? =zero-rat?)


; procedure for building a generic rational

(define (create-rational x y)
   (make-rational (make-rat x y)))

@end(programexample)