2015/11/05

# SICP 問題 2.89

``````;; 2.89
;; 濃い多項式に適している実装
(define (make-polynomial valiable term-list)
(cons valiable term-list))

(define (valiable p)
(car p))

(define (term-list p)
(cdr p))

(define (valiable? v)
(symbol? v))

(define (same-valiable? v1 v2)
(and (valiable? v1) (valiable? v2) (eq? v1 v2)))

(define (=zero-term? L)
(let ((L1 (term-list L)))
(or (empty-termlist? L1)
(and (=zero? (coeff (first L1)))
(=zero-term? (rest-terms L1))))))

(define (adjoin-term term term-list) (cons term term-list))

(define (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 (make-term order coeff) (cons coeff (iota order 0 0)))
(define (order term) (length (rest-terms term)))
(define (coeff term) (first-term term))

(define (negative-terms L)
(if (empty-termlist? L)
empty-termlist
(addjoin-term (negative (first term))
(negative-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))
(o1 (order L1))
(o2 (order L2)))
((> o1 o2)
((< o1 o2)
(else
(add-terms (rest-terms L1) (rest-terms L2))))))))

(define (sub-terms L1 L2)
(cond ((empty-termlist? L2) L1)
((empty-termlist? L1) (negative-terms L1))
(else
(let ((t1 (first-term L1))
(t2 (first-term L2))
(o1 (order L1))
(o2 (order L2)))
((> o1 o2)
(sub-terms (rest-terms L1) L2)))
((< o1 o2)
(sub-terms L1 (rest-terms L2))))
(else
(adjoin-term (sub t1 t2)
(sub-terms (rest-terms L1) (rest-terms L2))))))))

(define (mul-terms L1 L2)
(cond ((empty-termlist? L1) (the-empty-termlist))
((empty-termlist? L2) (the-empty-termlist))
(else
(mul-term-by-all-terms
(make-term (first-term L1)
(iota (length (rest-terms L1) 0 0)))
L2)
(mul-terms (rest-terms L1) L2)))))

(define (mul-term-by-all-terms t L)
(if (empty-termlist L)
(rest-terms t)
(add-join-term (mul (first-term t) (first-term L))
(mul-term-by-all-terms t (rest-terms L)))))
``````