felixm
/
SICP
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Implement poly GCD and scale down coeffs (2.96)

main
Felix Martin 2020-12-08 20:01:09 -05:00
parent 6282f0aaab
commit 4040c2bf9d
1 changed files with 56 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
ex-2_77-97.scm
View File

@ -809,6 +809,12 @@
(define (order term) (car term))
(define (coeff term) (cadr term))
(define (coeffs term-list)
(if (empty-termlist? term-list)
'()
(cons (coeff (first-term term-list))
(coeffs (rest-terms term-list)))))
(define (add-terms L1 L2)
; (display "ADD-TERMS ") (display L1) (display L2) (newline)
(cond ((empty-termlist? L1) L2)
@ -986,17 +992,18 @@
(else (=zero?-terms (rest-terms terms)))))
(=zero?-terms (term-list p)))
(define (remainder-terms a b)
(cadr (div-terms a b)))
(define (gcd-terms a b)
; (display "GCD-TERMS") (display a) (display b) (newline)
(if (empty-termlist? b)
a
(gcd-terms b (remainder-terms a b))))
(define (gcd-poly p1 p2)
(display "GCD-POLY") (display p1) (display p2) (newline)
; (display "GCD-POLY") (display p1) (display p2) (newline)
(define (remainder-terms a b)
(cadr (div-terms a b)))
(define (gcd-terms a b)
; (display "GCD-TERMS") (display a) (display b) (newline)
(if (empty-termlist? b)
a
(gcd-terms b (remainder-terms a b))))
(if (same-variable? (variable p1) (variable p2))
(make-poly (variable p1)
(gcd-terms (term-list p1)
@ -1004,6 +1011,38 @@
(error "Polys not in same var -- ADD-POLY"
(list p1 p2))))
(define (gcd-poly-pseudo p1 p2)
; (display "GCD-POLY-PSEUDO") (display p1) (display p2) (newline)
(define (pseudo-remainder-terms p q)
(let ((o1 (order (first-term p)))
(o2 (order (first-term q)))
(c (coeff (first-term q))))
(let ((integerizing-factor
(expt c (+ 1 o1 (- o2)))))
(cadr (div-terms (scale-terms integerizing-factor p)
q)))))
(define (gcd-list xs)
(cond
((null? xs) 1)
((null? (cdr xs)) (car xs))
(else (gcd-list (cons (gcd (car xs) (cadr xs)) (cddr xs))))))
(define (gcd-terms a b)
; (display "GCD-TERMS-PSEUDO") (display a) (display b) (newline)
(if (empty-termlist? b)
a
(gcd-terms b (pseudo-remainder-terms a b))))
(if (same-variable? (variable p1) (variable p2))
(let ((result-terms (gcd-terms (term-list p1)
(term-list p2))))
(let ((gcd-result (gcd-list (coeffs result-terms))))
(make-poly (variable p1)
(scale-terms (/ 1 gcd-result) result-terms))))
(error "Polys not in same var -- ADD-POLY"
(list p1 p2))))
;; interface to rest of the system
(define (tag p) (attach-tag 'polynomial p))
(put 'add '(polynomial polynomial)
@ -1016,6 +1055,8 @@
(lambda (p1 p2) (div-poly p1 p2)))
(put 'greatest-comond-divisor '(polynomial polynomial)
(lambda (p1 p2) (tag (gcd-poly p1 p2))))
(put 'greatest-comond-divisor-pseudo '(polynomial polynomial)
(lambda (p1 p2) (tag (gcd-poly-pseudo p1 p2))))
(put '=zero? '(polynomial) =zero?-poly)
(put 'make 'poly-sparse
(lambda (var terms) (tag (make-poly-sparse var terms))))
@ -1111,5 +1152,11 @@
(display (greatest-common-divisor q1 q2)) (newline)
(display "\nex-2.96 - pseudoremainder and improved GCD\n")
(define (gcd-poly-pseudo x y) (apply-generic 'greatest-comond-divisor-pseudo x y))
(assert (gcd-poly-pseudo q1 q2) p1)
(display "\nex-2.97\n")