Feeds:
Posts
Comments

Archive for the ‘Project SICP’ Category

SICP Exercises Section 3.2.2

Posted in Chapter 3, Project SICP on December 29, 2010| Leave a Comment »

Exercise 3.9

Let’s start with the recursive factorial: 

(define (factorial n)
  (if (= n 1)
      1
      (* n (factorial (- n 1)))))

For simplicity, especially since drawing these pictures in OpenOffice is a bit tedious, let’s trace out the evaluation of (factorial 3) instead of (factorial 6). When the procedure factorial is applied to the argument 3 a new environment E1 is created who’s parent environment is the environment in which factorial was defined (the global environment), and in which the formal parameter n is bound to the value 3. Then the body of factorial is evaluated in this new environment, resulting in another application of factorial with 2 as an argument. This creates a new environment E2 in which the formal parameter n is bound to 2. The environment E3 is created in a similar manner, with n bound to 1. Finally the base case of factorial is reached, the computation unwinds and finishes:

Now let’s examine the iterative version of factorial: 

(define (factorial n)
  (fact-iter 1 1 n))

(define (fact-iter product counter max-count)
  (if (> counter max-count)
      product
      (fact-iter (* counter product)
                 (+ counter 1)
                 max-count)))

Again everything starts with the application (factorial 3). The body of factorial is evaluated in an environment E1, where the formal parameter n is bound to 3. This results in the application (fact-iter 1 1 n), which reduces to evaluating the body of the procedure fact-iter in a new environment E2 with the formal parameters product, counter, and max-count bound to 1, 1, and 3 respectively. The process continues with the environments E3, E4, and E5 being created along the way until the computation finally ends:

Read Full Post »

SICP Exercises Section 3.1.3

Posted in Chapter 3, Project SICP on December 29, 2010| Leave a Comment »

Exercise 3.7

Make-joint can be implemented to return a procedure that takes two arguments – a password password and a message m. It works by checking whether password and new-password match and if they do sends the message to the local account object along with the original password: 

(define (make-joint account account-password new-password)
  (lambda (password m)
    (if (eq? password new-password)
        (account account-password m)
        "Incorrect password")))

No changes to make-account are required.


Exercise 3.8

Let f be a procedure with a single local state variable last which stores the value of the argument x that was last passed to f. Initially, if f has not been called, last has the value of 0. When applied, f updates the value of last to that of its argument and returns the old value of last: 

(define f
  (let ((last 0))
    (lambda (x) 
      (let ((result last))
        (set! last x)
        result))))

Now let’s consider the evaluation of the expression (+ (f 0) (f 1)). If the arguments are evaluated from left to right the first application (f 0) will evaluate to 0 (the initial value of last), and the second application (f 1) will also evaluate to 0 (the value of the argument in the previous application). Adding up 0 and 0 we get 0. If, however, the arguments are evaluated from right to left the first application would be (f 1) which evaluates to 0 (the initial value of last), and the second application (f 0) would evaluate to 1 – the value of the argument in the previous application. When we add the two together we get 1.

Read Full Post »

SICP Exercises Section 3.1.2

Posted in Chapter 3, Project SICP on December 14, 2010| Leave a Comment »

Exercise 3.5

Estimate-integral defines an internal test procedure. Its task is to generate random x and y coordinates and check whether they satisfy the predicate P. This procedure is then passed as the experiment argument to the Monte Carlo simulation. The result of the simulation is multiplied by the area of the bounding rectangle within which the random coordinates are generated: 

;; Returns a random number in the interval [low, high).
(define (random-in-range low high)
  (let ((range (- high low)))
    (+ low (* range (random)))))

(define (estimate-integral P x1 x2 y1 y2 trails)
  (define (test)
    (P (random-in-range x1 x2)
       (random-in-range y1 y2)))
  (let ((area (* 1.0 (- x2 x1) (- y2 y1))))
    (* area (monte-carlo trails test))))

Having defined estimate-integral we can use it to estimate the area of a unit circle by passing the appropriate predicate, bounding rectangle and number of trials: 

(estimate-integral 
 (lambda (x y)
   (<= (+ (square x) (square y)) 1))
 -1.0
 1.0
 -1.0
 1.0
 100000)

=> 3.14292

Note that in PLT Racket random is not defined when the language is set to R5RS. Furthermore, if we change the language to Racket, random does not work with a single argument that is a floating point number. However, if random is called with no arguments, it returns a random number in the range [0, 1). This number can then be multiplied by some other number, say r, to get a random number in the range [0, r). This is the technique random-in-range uses.


Exercise 3.6

The message-passing paradigm is very appropriate for dealing with this particular task. Rand can be defined as a procedure that takes a single argument – a message. If the message is the symbol generate, then the local state of the random-number generator is updated, and the next value in the sequence is returned. If, however, the message is the symbol reset, then a new procedure that resets the internal state variable to a provided value is returned. 

(define rand 
  (let ((x random-init))
    (lambda (m)
      (cond ((eq? m 'generate)
             (set! x (random-update x))
             x)
            ((eq? m 'reset)
             (lambda (value)
               (set! x value)))
            (else (error "Unkown request -- RAND" m))))))

Read Full Post »

SICP Exercises Section 3.1.1

Posted in Chapter 3, Project SICP on December 13, 2010| Leave a Comment »

Exercise 3.1

Definition of make-accumulator: 

(define (make-accumulator sum)
  (lambda (amount)
    (set! sum (+ sum amount))
    sum))


Exercise 3.2

The implementation of make-monitored uses the message-passing style of programming: 

(define (make-monitored f)
  (let ((times-called 0))
    (lambda (arg)
      (cond ((eq? arg 'how-many-calls?) times-called)
            ((eq? arg 'reset-count) (set! times-called 0))
            (else 
             (set! times-called (+ times-called 1))
             (f arg))))))


Exercise 3.3

In order to modify the make-account procedure, so that it creates password-protected accounts, we can change the definition of the internal dispatch procedure, to first check the provided password. If it is incorrect then the string “Incorrect password” is returned. Otherwise the message is processed and the appropriate procedure, either withdraw or deposit, is returned. The benefit of this approach is that the password check has to be implemented only in a single place: 

(define (make-account balance password)
  (define (withdraw amount)
    (if (>= balance amount)
        (begin (set! balance (- balance amount))
               balance)
        "Insufficient funds"))
  (define (deposit amount)
    (set! balance (+ balance amount))
    balance)
  (define (bad-password? pass)
    (not (eq? pass password)))
  (define (dispatch pass m)
    (cond ((bad-password? pass) "Incorrect password")
          ((eq? m 'withdraw) withdraw)
          ((eq? m 'deposit) deposit)
          (else (error "Unknown request -- MAKE-ACCOUNT" m))))
  dispatch)

Note that using this implementation, will cause the second example in the book to return an error rather than the message “Incorrect password”. The expression (acc ‘some-other-password ‘deposit) will evaluate to the string “Incorrect password” which will then be applied to 50. However the fact that the incorrect password is detected and signaled at the earliest possible moment makes much more sense than returning some procedure that, when called, will complain about the incorrectness of the previously provided password.


Exercise 3.4

The “centralized” password validation implemented in the previous exercise makes the new modification much easier. All code changes are limited to the bad-password? predicate and to introducing a new local variable – incorrect-guesses. 

(define (make-account balance password)
  (let ((incorrect-guesses 0))
    (define (withdraw amount)
      (if (>= balance amount)
          (begin (set! balance (- balance amount))
                 balance)
          "Insufficient funds"))
    (define (deposit amount)
      (set! balance (+ balance amount))
      balance)
    (define (bad-password? pass)
      (cond ((eq? pass password) 
             (set! incorrect-guesses 0)
             #f)
            (else 
             (set! incorrect-guesses (+ incorrect-guesses 1))
             (if (> incorrect-guesses 7) (call-the-cops))
             #t)))
    (define (dispatch pass m)
      (cond ((bad-password? pass) "Incorrect password")
            ((eq? m 'withdraw) withdraw)
            ((eq? m 'deposit) deposit)
            (else (error "Unknown request -- MAKE-ACCOUNT" m))))
    dispatch))

Read Full Post »

SICP Exercises Section 2.5.3

Posted in Chapter 2, Project SICP on December 2, 2010| Leave a Comment »

Exercise 2.87

A polynomial is zero if all the coefficients of all its terms are zeroes. To implement this logic we can add the following code to the polynomial package: 

(define (zero-terms? L)
    (if (empty-termlist? L)
        #t
        (and (=zero? (coeff (first-term L)))
             (zero-terms? (rest-terms L)))))

(define (zero-poly? p)
    (zero-terms? (term-list p)))

(put '=zero? '(polynomial) zero-poly?)


Exercise 2.88

To implement the subtraction operation for polynomials we will follow the given hint and reduce the operation to addition. In order to achieve this we have to define a generic negate operation and provide implementations of it for all the types in the arithmetic system. For all types, except polynomials, negate can be defined as multiplication by -1: 

;;generic negate operation
(define (negate x) (apply-generic 'negate x))

;;add to the scheme number package
(put 'negate '(scheme-number) 
     (lambda (x) (tag (* -1 x))))

;;add to the rational number package
(put 'negate '(rational) 
     (lambda (x) (tag (mul-rat (make-rat -1 1) x))))

;;add to the complex number package
(put 'negate '(complex) 
     (lambda (x) (tag (mul-complex (make-from-real-imag -1.0 0.0) x))))

To negate a polynomial, however, we have to negate all the coefficients of its terms: 

;;code to be added to the polynomial package
(define (negate-terms L)
    (if (empty-termlist? L)
        (the-empty-termlist)
        (let ((t (first-term L)))
          (adjoin-term (make-term (order t) (negate (coeff t)))
                       (negate-terms (rest-terms L))))))

(define (negate-poly p)
    (make-poly (variable p)
               (negate-terms (term-list p))))

(put 'negate '(polynomial) (lambda (p) (tag (negate-poly p))))

Finally, we can reduce subtraction to addition with the negative of the subtrahend as addend: 

;;code to be added to the polynomial package
(define (sub-poly p1 p2)
    (add-poly p1 (negate-poly p2)))

(put 'sub '(polynomial polynomial)
     (lambda (p1 p2) (tag (sub-poly p1 p2))))


Exercise 2.89

The following procedures implement the term-list representation as appropriate for dense polynomials and can replace the previous representation in polynomial package: 

;;Term lists for dense polynomials
(define (make-term order coeff) (list order coeff))
(define (order term) (car term))
(define (coeff term) (cadr term))
(define (the-empty-termlist) '())
(define (first-term term-list) 
  (make-term (- (length term-list) 1)
             (car term-list)))
(define (rest-terms term-list) (cdr term-list))
(define (empty-termlist? term-list) (null? term-list))
(define (adjoin-term term term-list)
  (let ((term-order (order term))
        (list-length (length term-list)))
    (cond ((= term-order list-length) 
           (cons (coeff term) term-list))
          ((> term-order list-length) 
           (cons (coeff term)
                 (adjoin-term (make-term (- term-order 1) 0) term-list)))
          (else (error "Term order to small to be adjoined" (list term term-list))))))

The most interesting parts are the first-term and adjoin-term procedures.

Since the dense representation is a list of coefficients, first-term has to construct a new term from the coefficient found at the car of its term-list argument and compute its order by taking the length of term-list and subtracting 1.

Adjoin-list works by assuming that the order of its first argument – term (the term being adjoined) is greater than the order of its second argument – term-list. If this condition is not met an error is signaled. Otherwise the resulting term list is the coefficient of the term, followed by some number of zeroes, followed by the term-list we are adjoining to. This is done recursively. The base case is the situation where term “fits” directly in front of the term-list – no extra zeroes are required. In the recursive case we cons the coefficient of term with the result of adjoining a new term with a coefficient of zero and an order of one less than that of the current term with term-list.


Exercise 2.90

To make the system support both sparse and dense polynomial representations I have decided to split the polynomial package in two separate packages – one for sparse polynomials and one for dense polynomials, each of them containing a different representation of term-lists: 

;;;Sparse polynomial package
(define (install-sparse-polynomial-package)
  ;;internal procedures
  (define (make-poly variable term-list) 
    (cons variable term-list))
  (define (variable p) (car p))
  (define (term-list p) (cdr p))
  (define (same-variable? v1 v2)
    (and (symbol? v1) (symbol? v2) (eq? v1 v2)))
  
  ;;Term lists for sparse polynomials
  (define (make-term order coeff) (list order coeff))
  (define (order term) (car term))
  (define (coeff term) (cadr term))
  (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 (adjoin-term term term-list)
    (if (=zero? (coeff term))
        term-list
        (cons term term-list)))
  (define (zero-terms? L)
    (if (empty-termlist? L)
        #t
        (and (=zero? (coeff (first-term L)))
             (zero-terms? (rest-terms L)))))
  (define (negate-terms L)
    (if (empty-termlist? L)
        (the-empty-termlist)
        (let ((t (first-term L)))
          (adjoin-term (make-term (order t) (negate (coeff t)))
                       (negate-terms (rest-terms L))))))
  
  (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)))))))))
  
  (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))))))
  
  (define (add-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (make-poly (variable p1)
                   (add-terms (term-list p1)
                              (term-list p2)))
        (error "Polys not in same variable -- ADD-POLY" (list p1 p2))))
  
  (define (mul-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (make-poly (variable p1)
                   (mul-terms (term-list p1)
                              (term-list p2)))
        (error "Polys not in same variable -- MUL-POLY" (list p1 p2))))
  
  (define (sub-poly p1 p2)
    (add-poly p1 (negate-poly p2)))
  
  (define (zero-poly? p)
    (zero-terms? (term-list p)))
  
  (define (negate-poly p)
    (make-poly (variable p)
               (negate-terms (term-list p))))
  
  ;;interface to rest of system
  (define (tag x) 
    (attach-tag 'sparse-polynomial x))
  (put 'add '(sparse-polynomial sparse-polynomial) 
       (lambda (p1 p2) (tag (add-poly p1 p2))))
  (put 'sub '(sparse-polynomial sparse-polynomial)
       (lambda (p1 p2) (tag (sub-poly p1 p2))))
  (put 'mul '(sparse-polynomial sparse-polynomial)
       (lambda (p1 p2) (tag (mul-poly p1 p2))))
  (put '=zero? '(sparse-polynomial) zero-poly?)
  (put 'negate '(sparse-polynomial) (lambda (p) (tag (negate-poly p))))
  (put 'make 'sparse-polynomial
       (lambda (var terms) (tag (make-poly var terms))))
  
  'done)

(define (make-sparse-polynomial var terms)
  ((get 'make 'sparse-polynomial) var terms))


;;;Dense polynomial package
(define (install-dense-polynomial-package)
  ;;internal procedures
  (define (make-poly variable term-list) 
    (cons variable term-list))
  (define (variable p) (car p))
  (define (term-list p) (cdr p))
  (define (same-variable? v1 v2)
    (and (symbol? v1) (symbol? v2) (eq? v1 v2)))
  
  ;;Term lists for dense polynomials
  (define (make-term order coeff) (list order coeff))
  (define (order term) (car term))
  (define (coeff term) (cadr term))
  (define (the-empty-termlist) '())
  (define (first-term term-list) 
    (make-term (- (length term-list) 1)
               (car term-list)))
  (define (rest-terms term-list) (cdr term-list))
  (define (empty-termlist? term-list) (null? term-list))
  (define (adjoin-term term term-list)
    (let ((term-order (order term))
          (list-length (length term-list)))
      (cond ((= term-order list-length) 
             (cons (coeff term) term-list))
            ((> term-order list-length) 
             (cons (coeff term)
                   (adjoin-term (make-term (- term-order 1) 0) term-list)))
            (else (error "Term order to small to be adjoined" (list term term-list))))))
  
  
  (define (zero-terms? L)
    (if (empty-termlist? L)
        #t
        (and (=zero? (coeff (first-term L)))
             (zero-terms? (rest-terms L)))))
  (define (negate-terms L)
    (if (empty-termlist? L)
        (the-empty-termlist)
        (let ((t (first-term L)))
          (adjoin-term (make-term (order t) (negate (coeff t)))
                       (negate-terms (rest-terms L))))))
  
  (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)))))))))
  
  (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))))))
  
  (define (add-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (make-poly (variable p1)
                   (add-terms (term-list p1)
                              (term-list p2)))
        (error "Polys not in same variable -- ADD-POLY" (list p1 p2))))
  
  (define (mul-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (make-poly (variable p1)
                   (mul-terms (term-list p1)
                              (term-list p2)))
        (error "Polys not in same variable -- MUL-POLY" (list p1 p2))))
  
  (define (sub-poly p1 p2)
    (add-poly p1 (negate-poly p2)))
  
  (define (zero-poly? p)
    (zero-terms? (term-list p)))
  
  (define (negate-poly p)
    (make-poly (variable p)
               (negate-terms (term-list p))))
  
  ;;interface to rest of system
  (define (tag x) 
    (attach-tag 'dense-polynomial x))
  (put 'add '(dense-polynomial dense-polynomial) 
       (lambda (p1 p2) (tag (add-poly p1 p2))))
  (put 'sub '(dense-polynomial dense-polynomial)
       (lambda (p1 p2) (tag (sub-poly p1 p2))))
  (put 'mul '(dense-polynomial dense-polynomial)
       (lambda (p1 p2) (tag (mul-poly p1 p2))))
  (put '=zero? '(dense-polynomial) zero-poly?)
  (put 'negate '(dense-polynomial) (lambda (p) (tag (negate-poly p))))
  (put 'make 'dense-polynomial
       (lambda (var terms) (tag (make-poly var terms))))
  
  'done)

(define (make-dense-polynomial var terms)
  ((get 'make 'dense-polynomial) var terms))


Exercise 2.91

The completed implementation of div-terms follows: 

(define (div-terms L1 L2)
  (if (empty-termlist? L1)
      (list (the-empty-termlist) (the-empty-termlist))
      (let ((t1 (first-term L1))
            (t2 (first-term L2)))
        (if (> (order t2) (order t1))
            (list (the-empty-termlist) L1)
            (let ((new-c (div (coeff t1) (coeff t2)))
                  (new-o (- (order t1) (order t2))))
              (let ((rest-of-result 
                     (div-terms 
                      (sub-terms
                       L1
                       (mul-term-by-all-terms 
                        (make-term new-o new-c)
                        L2))
                      L2)))
                (list (adjoin-term 
                       (make-term new-o new-c)
                       (car rest-of-result))
                      (cadr rest-of-result))))))))

(define (sub-terms L1 L2)
  (add-terms L1 (negate-terms L2)))

Note that we had to define sub-terms as a helper procedure so that we could subtract two term lists. To do so we rely on the negate-terms procedure that was defined earlier (see Exercise 2.88).

Having this dividing two polynomials becomes straight forward: 

(define (div-poly p1 p2)
  (if (same-variable? (variable p1) (variable p2))
      (let ((result (div-terms (term-list p1) (term-list p2))))
        (list (make-poly (variable p1)
                         (car result))
              (make-poly (variable p1)
                         (cadr result))))
      (error "Polys not in same variable -- DIV-POLY" (list p1 p2))))


Exercise 2.92

Skipped.


Exercise 2.93

After modifying the rational-number package to use generic operations and changing the constructor so that no reduction of fractions takes place, we can create rational functions and apply generic arithmetic on them: 

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

(add rf rf)
=> (rational (polynomial x (5 2) (3 2) (2 2) (0 2)) polynomial x (4 1) (2 2) (0 1))

As can be expected the result is not reduced to lowest terms.


Exercise 2.94

Definitions of remainder-terms, gcd-terms, and gcd-poly which can be added to the polynomial package: 

(define (remainder-terms a b)
  (cadr (div-terms a b)))
  
(define (gcd-terms a b)
  (if (empty-termlist? b)
      a
      (gcd-terms b (remainder-terms a b))))

(define (gcd-poly a b)
  (if (same-variable? (variable a) (variable b))
      (make-poly (variable a)
                 (gcd-terms (term-list a) 
                            (term-list b)))
      (error "Polys not in same variable -- GCD-POLY" (list a b))))

Code for installing in the system greatest-common-divisor as a generic operation and registering concrete implementations for ordinary numbers and polynomials: 

;;Generic operation - greatest-common-divisor
(define (greatest-common-divisor x y) (apply-generic 'greatest-common-divisor x y))

;;Should be added to the polynomial package
(put 'greatest-common-divisor '(polynomial polynomial) 
     (lambda (p1 p2) (tag (gcd-poly p1 p2))))

;;Should be added to the scheme-number package
(put 'greatest-common-divisor '(scheme-number scheme-number)
     (lambda (x y) (tag (gcd x y))))

When testing greatest-common-divisor we get: 

(p1 (make-polynomial 'x '((4 1) (3 -1) (2 -2) (1 2))))
(p2 (make-polynomial 'x '((3 1) (1 -1)))))
(greatest-common-divisor p1 p2)
=> (polynomial x (2 -1) (1 1))


Exercise 2.95

Let’s try the example: 

(define p1 (make-polynomial 'x '((2 1) (1 -2) (0 1))))
(define p2 (make-polynomial 'x '((2 11) (0 7))))
(define p3 (make-polynomial 'x '((1 13) (0 5))))
(define q1 (mul p1 p2))
(define q2 (mul p1 p3))

(greatest-common-divisor q1 q2)
=> (polynomial x (2 1458/169) (1 -2916/169) (0 1458/169))

Greatest-common-divisor definitely does not return p1, but it does return a polynomial (of the same order as p1) that divides both q1 and q2. So why does it not return p1? Apparently because it has found some other polynomial that it deems “greater” than p1, and that is a divisor of q1 and q2.


Exercise 2.96

When defining pseudoremainder-terms it is convenient to have a helper procedure that computes the integerizing factor when given two term lists: 

(define (integerizing-factor a b)
    (if (or (empty-termlist? a) (empty-termlist? b))
        0
        (let ((t1 (first-term a))
              (t2 (first-term b)))
          (expt (coeff t2)
                (+ (order t1)
                   (- (order t2))
                   1)))))
  
  (define (pseudoremainder-terms a b)
    (remainder-terms 
     (mul-term-by-all-terms 
      (make-term 0 (integerizing-factor a b))
      a)
     b))

After modifying the gcd-terms procedure we can test again the example from the previous exercise and confirm that we do not get fractions: 

(define (gcd-terms a b)
  (if (empty-termlist? b)
      a
      (gcd-terms b (pseudoremainder-terms a b))))
  
(greatest-common-divisor q1 q2)
=> (polynomial x (2 1458) (1 -2916) (0 1458))

The rest of the exercise requires gcd-terms to remove the common factors from the coefficients of its result. To simplify the implementation we can define another helper procedure reduce-termlist: 

(define (reduce-termlist term-list)
  (mul-term-by-all-terms (make-term 0
                                    (div 1 (apply gcd (map coeff term-list))))
                         term-list))
  
(define (gcd-terms a b)
  (if (empty-termlist? b)
      (reduce-termlist a)
      (gcd-terms b (pseudoremainder-terms a b))))


Exercise 2.97

Definitions of reduce-terms and reduce-poly. To simplify the implementation two helper procedures – mul-terms-by-scalar and quotient-terms are introduced: 

(define (mul-terms-by-scalar s term-list)
  (mul-term-by-all-terms (make-term 0 s)
                         term-list))
  
(define (quotient-terms a b)
  (car (div-terms a b)))
  
(define (reduce-terms n d)
  (let* ((g (gcd-terms n d))
         (factor
          (integerizing-factor 
           (if (> (order (first-term n))
                  (order (first-term d)))
               n
               d)
           g))
         (n1 (mul-terms-by-scalar factor n))
         (d1 (mul-terms-by-scalar factor d))
         (n2 (quotient-terms n1 g))
         (d2 (quotient-terms d1 g))
         (coeff-gcd (gcd (apply gcd (map coeff n2))
                         (apply gcd (map coeff d2)))))
    (list (mul-terms-by-scalar (div 1 coeff-gcd) n2)
          (mul-terms-by-scalar (div 1 coeff-gcd) d2))))

(define (reduce-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (let ((result (reduce-terms (term-list p1) (term-list p2))))
          (list (make-poly (variable p1) (car result))
                (make-poly (variable p2) (cadr result))))
        (error "Polys not in same variable -- REDUCE-POLY" (list p1 p2))))

Code that defines the generic reduce operation, provides implementations of it for polynomials and scheme-numbers and reimplements the make-rat constructor: 

;;Generic operation - reduce
(define (reduce x y) (apply-generic 'reduce x y))

;;Should be added to the scheme-number package
(put 'reduce '(scheme-number scheme-number)
     (lambda (x y) 
       (let ((result (reduce-integers x y)))
         (list (tag (car result)) (tag (cadr result))))))

;;Should be added to the polynomial package
(put 'reduce '(polynomial polynomial)
       (lambda (p1 p2)
         (let ((result (reduce-poly p1 p2)))
           (list (tag (car result)) (tag (cadr result))))))

;;Should be added to the rational package in place of the old constructor
(define (make-rat n d)
    (let ((result (reduce n d)))
      (cons (car result) (cadr result))))

Now if we test the code with the rational functions given at the beginning of the extended exercise we get: 

(p1 (make-polynomial 'x '((1 1) (0 1))))
(p2 (make-polynomial 'x '((3 1) (0 -1))))
(p3 (make-polynomial 'x '((1 1))))
(p4 (make-polynomial 'x '((2 1) (0 -1))))
(rf1 (make-rational p1 p2))
(rf2 (make-rational p3 p4))

(add rf1 rf2)
=> (rational (polynomial x (3 -1) (2 -2) (1 -3) (0 -1)) polynomial x (4 -1) (3 -1) (1 1) (0 1))

Note that the result is almost correct, the only difference is that the numerator and denominator are both multiplied by -1, but otherwise the rational function is simplified as expected.

Read Full Post »

Older Posts »

    • Design a site like this with WordPress.com
    Get started