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)
            (adjoin-term t1 (add-terms (rest-terms L1) L2)))
           ((< o1 o2)
            (adjoin-term t2 (add-terms L1 (rest-terms L2))))
           (else
            (addjoin-term (add t1 t2)
                          (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)
            (adjoin-term t1
                         (sub-terms (rest-terms L1) L2)))
           ((< o1 o2)
            (adjoin-term (negative t2)
                         (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
         (add-terms
          (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)))))