diff --git a/2_78.rkt b/2_78.rkt index c9555ff..3558292 100644 --- a/2_78.rkt +++ b/2_78.rkt @@ -165,6 +165,10 @@ ;; Scheme numbers (define (install-scheme-number-package) + + (define (reduce-integers n d) + (let ((g (gcd n d))) + (list (/ n g) (/ d g)))) (define (tag x) (attach-tag 'scheme-number x)) (define (exp x y) (apply-generic 'exp x y)) @@ -188,6 +192,11 @@ (lambda (x) (tag (sqrt x)))) (put 'greatest-common-divisor '(scheme-number scheme-number) (lambda (a b) (tag (gcd a b)))) + (put 'reduce '(scheme-number scheme-number) + (lambda (a b) + (let ((reduced (reduce-integers a b))) + (list (tag (car reduced)) + (tag (cadr reduced)))))) (put 'equ? '(scheme-number scheme-number) =) (put '=zero? '(scheme-number) (lambda (x) (= x 0))) @@ -251,7 +260,11 @@ ;; internal procedures (define (numer x) (car x)) (define (denom x) (cdr x)) - (define (make-rat n d) (cons n d)) + (define (make-rat n d) + (let ((reduced (reduce n d))) + (cons + (car reduced) + (cadr reduced)))) (define (add-rat x y) (make-rat (add (mul (numer x) (denom y)) (mul (numer y) (denom x))) @@ -491,6 +504,15 @@ (greatest-common-divisor (term-list p1) (term-list p2))))) + + (define (reduce-poly p1 p2) + (let ((reduced-termlist + (reduce (term-list p1) + (term-list p2)))) + (if (same-variable? (variable p1) (variable p2)) + (list + (make-poly (variable p1) (car reduced-termlist)) + (make-poly (variable p1) (cadr reduced-termlist)))))) (define (negate-poly p) (make-poly (variable p) @@ -519,6 +541,12 @@ (tag (cadr quotient-remainder)))))) (put 'greatest-common-divisor '(polynomial polynomial) (lambda (p1 p2) (tag (gcd-poly p1 p2)))) + (put 'reduce '(polynomial polynomial) + (lambda (p1 p2) + (let ((reduced (reduce-poly p1 p2))) + (list + (tag (car reduced)) + (tag (cadr reduced)))))) (put 'negate '(polynomial) (lambda (p) (tag (negate-poly p)))) (put '=zero? '(polynomial) @@ -594,6 +622,16 @@ (define (remainder-terms L1 L2) (cadr (div-terms L1 L2))) + + (define (mul-terms-by-scalar termlist s) + (mul-terms + termlist + (adjoin-term + (make-term 0 s) + ((get 'the-empty-termlist (type-tag termlist)))))) + + (define (div-terms-by-scalar termlist s) + (mul-terms-by-scalar termlist (/ 1 s))) (define (pseudo-remainder-terms L1 L2) (let* ((c (coeff (first-term L2))) @@ -609,22 +647,30 @@ L1) L2)))) + (define (coeff-gcd termlist) + (if (empty-termlist? termlist) + 0 + (gcd (coeff (first-term termlist)) + (coeff-gcd (rest-terms termlist))))) + (define (gcd-terms a b) - (define (coeff-gcd termlist) - (if (empty-termlist? termlist) - 0 - (gcd (coeff (first-term termlist)) - (coeff-gcd (rest-terms termlist))))) - (define (div-by-coeff-gcd termlist) - (div-terms - termlist - (adjoin-term - (make-term 0 (coeff-gcd termlist)) - ((get 'the-empty-termlist (type-tag termlist)))))) (if (empty-termlist? b) - (div-by-coeff-gcd a) + (div-terms-by-scalar a (coeff-gcd a)) (gcd-terms b (pseudo-remainder-terms a b)))) + (define (reduce-terms n d) + (let* ((term-gcd (gcd-terms n d)) + (o1 (max (order n) (order d))) + (o2 (order term-gcd)) + (i-factor (exp + (coeff (first-term term-gcd)) + (+ 1 (- o1 o2))))) + (list + ;; Dividing by the gcd will give remainder zero, so we are only + ;; interested in the quotient + (car (div-terms (mul-terms-by-scalar n i-factor) term-gcd)) + (car (div-terms (mul-terms-by-scalar d i-factor) term-gcd))))) + ;; Constructors (put 'make-sparse-empty-termlist 'termlist @@ -684,6 +730,13 @@ (lambda (L1 L2) (tag (gcd-terms L1 L2)))) + (put 'reduce '(termlist termlist) + (lambda (L1 L2) + (let ((reduced-termlist + (reduce-terms L1 L2))) + (list (tag (car reduced-termlist)) + (tag (cadr reduced-termlist)))))) + 'done) (define (install-sparse-package) @@ -730,6 +783,12 @@ (put 'empty-termlist? '(sparse) empty-termlist?) + (put 'order '(sparse) + (lambda (termlist) + (if (pair? termlist) + (caar termlist) + 0))) + ;; Operators (put 'negate '(sparse) (lambda (termlist) @@ -795,6 +854,8 @@ (put 'empty-termlist? '(dense) empty-termlist?) + (put 'order '(dense) highest-order-term) + ;; Operators (put 'negate '(dense) (lambda (termlist) @@ -888,6 +949,8 @@ (define (square x) (mul x x)) (define (greatest-common-divisor a b) (apply-generic 'greatest-common-divisor a b)) +(define (reduce a b) + (apply-generic 'reduce a b)) (define (equ? x y) (apply-generic 'equ? x y)) ;;(put 'equ? '(complex complex) equ?) @@ -948,20 +1011,42 @@ ;; 2.95 -(define p1 (make-polynomial 'x - (adjoin-term (make-term 2 1) - (adjoin-term (make-term 1 -2) - (adjoin-term (make-term 0 1) - (make-sparse-empty-termlist)))))) -(define p2 (make-polynomial 'x - (adjoin-term (make-term 2 11) - (adjoin-term (make-term 0 7) - (make-sparse-empty-termlist))))) -(define p3 (make-polynomial 'x (adjoin-term (make-term 1 13) - (adjoin-term (make-term 0 5) - (make-sparse-empty-termlist))))) -(define q1 (mul p1 p2)) -(define q2 (mul p1 p3)) +;;(define p1 (make-polynomial 'x +;; (adjoin-term (make-term 2 1) +;; (adjoin-term (make-term 1 -2) +;; (adjoin-term (make-term 0 1) +;; (make-sparse-empty-termlist)))))) +;;(define p2 (make-polynomial 'x +;; (adjoin-term (make-term 2 11) +;; (adjoin-term (make-term 0 7) +;; (make-sparse-empty-termlist))))) +;;(define p3 (make-polynomial 'x (adjoin-term (make-term 1 13) +;; (adjoin-term (make-term 0 5) +;; (make-sparse-empty-termlist))))) +;;(define q1 (mul p1 p2)) +;;(define q2 (mul p1 p3)) ;; GCD of q1 and q2 is not p1: it is a polynomial with rational coefficients because ;; of the division of coefficients. + +;; 2.97 + +(define p1 (make-polynomial 'x + (adjoin-term (make-term 1 1) + (adjoin-term (make-term 0 1) + (make-sparse-empty-termlist))))) +(define p2 (make-polynomial 'x + (adjoin-term (make-term 3 1) + (adjoin-term (make-term 0 -1) + (make-sparse-empty-termlist))))) +(define p3 (make-polynomial 'x + (adjoin-term (make-term 1 1) + (make-sparse-empty-termlist)))) + +(define p4 (make-polynomial 'x + (adjoin-term (make-term 2 1) + (adjoin-term (make-term 0 -1) + (make-sparse-empty-termlist))))) + +(define rf1 (make-rational p1 p2)) +(define rf2 (make-rational p3 p4))