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

Add polynomial division (exercise 2.91)

This commit is contained in:
Oliver Payne 2022-04-15 14:37:12 +01:00
parent 0b608a1bf9
commit d03714f749
1 changed files with 62 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
2_78.rkt
View File

@ -472,6 +472,19 @@
(error "Polys not in same var -- MUL-POLY"
(list p1 p2))))
(define (div-poly p1 p2)
(if (same-variable? (variable p1) (variable p2))
(let ((quotient-remainder
(div (term-list p1)
(term-list p2))))
(list
(make-poly (variable p1)
(car quotient-remainder))
(make-poly (variable p1)
(cadr quotient-remainder))))
(error "Polys not in same var -- DIV-POLY"
(list p1 p2))))
(define (negate-poly p)
(make-poly (variable p)
(negate (term-list p))))
@ -491,6 +504,12 @@
(lambda (p1 p2) (tag (add-poly p1 (negate-poly p2)))))
(put 'mul '(polynomial polynomial)
(lambda (p1 p2) (tag (mul-poly p1 p2))))
(put 'div '(polynomial polynomial)
(lambda (p1 p2)
(let ((quotient-remainder (div-poly p1 p2)))
(list
(tag (car quotient-remainder))
(tag (cadr quotient-remainder))))))
(put 'negate '(polynomial)
(lambda (p) (tag (negate-poly p))))
(put '=zero? '(polynomial)
@ -521,6 +540,8 @@
(add (coeff t1) (coeff t2)))
(add-terms (rest-terms L1)
(rest-terms L2)))))))))
(define (sub-terms L1 L2)
(add-terms L1 (negate L2)))
(define (mul-terms L1 L2)
(if (empty-termlist? L1)
@ -538,6 +559,30 @@
(mul (coeff t1) (coeff t2)))
(mul-term-by-all-terms t1 (rest-terms L))))))
(define (div-terms L1 L2)
(if (empty-termlist? L1)
(list ((get 'the-empty-termlist (type-tag L1)))
((get 'the-empty-termlist (type-tag L2))))
(let ((t1 (first-term L1))
(t2 (first-term L2)))
(if (> (order t2) (order t1))
(list ((get 'the-empty-termlist (type-tag L1))) 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))) ;compute rest of result recursively
(cons
(adjoin-term
(make-term new-o new-c)
(car rest-of-result))
(cdr rest-of-result)))))))) ;form complete result
;; Constructors
(put 'make-sparse-empty-termlist 'termlist
(lambda ()
@ -574,10 +619,20 @@
(lambda (L1 L2)
(tag (add-terms L1 L2))))
(put 'sub '(termlist termlist)
(lambda (L1 L2)
(tag (sub-terms L1 L2))))
(put 'mul '(termlist termlist)
(lambda (L1 L2)
(tag (mul-terms L1 L2))))
(put 'div '(termlist termlist)
(lambda (L1 L2)
(let ((quotient-remainder (div-terms L1 L2)))
(list (tag (car quotient-remainder))
(tag (cdr quotient-remainder))))))
(put 'negate '(termlist)
(lambda (L)
(tag (negate L))))
@ -646,14 +701,19 @@
(if (= order (highest-order-term term-list))
term-list
(zero-pad order (cons 0 term-list))))
(define (strip-leading-zeros term-list)
(cond ((null? term-list) '())
((not (= (car term-list) 0))
term-list)
(else strip-leading-zeros (cdr term-list))))
(let ((term-list-order (highest-order-term term-list)))
(cond ((and (null? term-list)
(= (order term) 0))
(list (coeff term)))
((= (coeff term) 0)
(strip-leading-zeros term-list))
((= (order term) (+ term-list-order 1))
(cons (coeff term) term-list))
((= (coeff term) 0)
term-list)
(else
(cons (coeff term)
(zero-pad