2.5.3 例:記号代数

暇すぎて SICP を復習してきましたが、第二章もついに最終節になりました。9 月からプータローになるため、さらに復習が捗るかもしれません。いや、ゲームばっかやってるかもだけどｗｗｗ*1

;;;;; 2.5.3 例:記号代数

(define (install-polynomial-package)
  ;; 内部手続き
  ;; 多項式型の表現
  (define (make-poly variable term-list)
    (cons variable term-list))
  (define (variable p) (car p))
  (define (term-list p) (cdr p))
  (define (variable? x) (symbol? x))
  (define (same-variable? v1 v2)
    (and (variable? v1) (variable? v2) (eq? v1 v2)))

  ;; 項と項リストの表現
  (define (the-empty-termlist) '())

  (define (empty-termlist? term-list) (null? term-list))
  (define (first-term term-list) (car term-list))
  (define (rest-terms term-list) (cdr term-list))

  (define (make-term order coeff) (list order coeff))
  (define (order term) (car term))
  (define (coeff term) (cadr term))

  (define (adjoin-term term term-list)
    (if (=zero? (coeff term))
        term-list
        (cons term term-list)))

  (define (add-terms L1 L2)
    (cond ((empty-termlist? L1) L2)
          ((empty-termlist? L2) L1)
          (else
           (let ((t1 (first-term L1))
                 (t2 (first-term L2)))
             (cond ((> (order t1) (order t2))
                    (adjoin-term t1 (add-terms (rest-terms L1) L2)))
                   ((< (order t1) (order t2))
                    (adjoin-term t2 (add-terms L1 (rest-terms L2))))
                   (else
                    (adjoin-term
                     (make-term (order t1)
                                (add (coeff t1) (coeff t2)))
                     (add-terms (rest-terms L1)
                                (rest-terms L2)))))))))

  (define (mul-terms L1 L2)
    (if (empty-termlist? L1)
        (the-empty-termlist)
        (add-terms (mul-term-by-all-terms (first-term L1) L2)
                   (mul-terms (rest-terms L1) L2))))

  (define (mul-term-by-all-terms t1 L)
    (if (empty-termlist? L)
        (the-empty-termlist)
        (let ((t2 (first-term L)))
          (adjoin-term
           (make-term (+ (order t1) (order t2))
                      (mul (coeff t1) (coeff t2)))
           (mul-term-by-all-terms t1 (rest-terms L))))))

  (define (add-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (make-poly (variable p1)
                   (add-terms (term-list p1)
                              (term-list p2)))
        (error "Polys not in same var -- ADD-POLY"
               (list p1 p2))))

  (define (mul-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (make-poly (variable p1)
                   (mul-terms (term-list p1)
                              (term-list p2)))
        (error "Polys not in same var -- MUL-POLY"
               (list p1 p2))))

  ;; システムの他の部分とのインターフェース
  (define (tag p) (attach-tag 'polynomial p))
  (put 'add '(polynomial polynomial)
       (lambda (p1 p2) (tag (add-poly p1 p2))))
  (put 'mul '(polynomial polynomial)
       (lambda (p1 p2) (tag (mul-poly p1 p2))))
  (put 'make 'polynomial
       (lambda (var terms) (tag (make-poly var terms))))
  'done)

(define (make-polynomial var terms)
  ((get 'make 'polynomial) var terms))

;;;;;

(install-scheme-number-package)
(install-scheme-real-package)
(install-rational-package)
(install-rectangular-package)
(install-polar-package)
(install-complex-package)
(install-polynomial-package)

このコードを問題 2.86 の最後にくっつければ、ひとまず完成。
(本書に載ってるコードを打ち込んだだけという説もあるｗ)
ただし、install-*-package だけは一番最後に移動しよう。

;; (x^100 + 2x^2 + 1) + (x^10 + 5x^2)
;; make-term の部分は、order (次数) coeff (係数) の順で指定する。
;; 間違えやすいので注意。

gosh> (add (make-polynomial 'x '((100 1) (2 2) (0 1))) (make-polynomial 'x '((10 1) (2 5))))
(polynomial x (100 1) (10 1) (2 7) (0 1))
;; ===> x^100 + x^10 + 7x^2 + 1

;; (x^2 + 1) * (x^3 + 4x + 5)
gosh> (mul (make-polynomial 'x '((2 1) (0 1))) (make-polynomial 'x '((3 1) (1 4) (0 5))))
(polynomial x (5 1) (3 5) (2 5) (1 4) (0 5))
;; ==> x^5 + 5x^3 + 5x^2 + 4x + 5

こんな風に多項式の演算ができる。
ゲーム漬けになっていなかったら、次回から問題を解いていきまーす。

*1:もうすぐスターフィールド来ちゃうからね