ompayne
/
sicp
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Add generic gcd operator and tests for exercise 2.95

This commit is contained in:
Oliver Payne 2022-04-15 22:20:02 +01:00
parent de39768f9d
commit 6c40d82224
1 changed files with 43 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
2_78.rkt
View File

@ -186,6 +186,8 @@
(lambda (x) (tag (cos x))))
(put 'square-root '(scheme-number)
(lambda (x) (tag (sqrt x))))
(put 'greatest-common-divisor '(scheme-number scheme-number)
(lambda (a b) (tag (gcd a b))))
(put 'equ? '(scheme-number scheme-number) =)
(put '=zero? '(scheme-number)
(lambda (x) (= x 0)))
@ -482,6 +484,13 @@
(cadr quotient-remainder))))
(error "Polys not in same var -- DIV-POLY"
(list p1 p2))))
(define (gcd-poly p1 p2)
(if (same-variable? (variable p1) (variable p2))
(make-poly (variable p1)
(greatest-common-divisor
(term-list p1)
(term-list p2)))))
(define (negate-poly p)
(make-poly (variable p)
@ -508,6 +517,8 @@
(list
(tag (car quotient-remainder))
(tag (cadr quotient-remainder))))))
(put 'greatest-common-divisor '(polynomial polynomial)
(lambda (p1 p2) (tag (gcd-poly p1 p2))))
(put 'negate '(polynomial)
(lambda (p) (tag (negate-poly p))))
(put '=zero? '(polynomial)
@ -581,6 +592,15 @@
(car rest-of-result))
(cdr rest-of-result)))))))) ;form complete result
(define (remainder-terms L1 L2)
(cadr (div-terms L1 L2)))
(trace-define (gcd-terms a b)
(if (empty-termlist? b)
a
(gcd-terms b (remainder-terms a b))))
;; Constructors
(put 'make-sparse-empty-termlist 'termlist
(lambda ()
@ -635,6 +655,10 @@
(lambda (L)
(tag (negate L))))
(put 'greatest-common-divisor '(termlist termlist)
(lambda (L1 L2)
(tag (gcd-terms L1 L2))))
'done)
(define (install-sparse-package)
@ -837,6 +861,8 @@
(define (arctan x y) (apply-generic 'arctan x y))
(define (negate x) (apply-generic 'negate x))
(define (square x) (mul x x))
(define (greatest-common-divisor a b)
(apply-generic 'greatest-common-divisor a b))
(define (equ? x y) (apply-generic 'equ? x y))
;;(put 'equ? '(complex complex) equ?)
@ -896,4 +922,21 @@
;; 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))
;; GCD of q1 and q2 is not p1: it is a polynomial with rational coefficients because
;; of the division of coefficients.