SICP §2.5.3 記号代数

Scheme SICP

最後の10問の前にこんな重めのセクションが・・・もう３章行きてぇ〜。

つーわけで、今までの汎用演算システムに、代数的な要素も入れちゃおうという話。
このセクションでは多項式（polynomial）を演算対象に含めることを目的とするらしい。

パッケージとして多項式の演算処理を実装するので、こんな手続きが必要になってinstall-polynomial-package手続きの中に定義する感じになる。もっと必要になるかもしれんけど。

更に、多項式は「項」と「変数」で構成されているので、こんな手続きも必要になる。
  • 項の構成子
  • 項の選択子
  • 項の述語
  • 変数の述語
  • 項の加算処理（減算は不要）
  • 項の乗算処理（除算も不要？あった方が便利な気がするけど。。）
とりあえずこんなもんか。読み進めていくうちに必要になる手続きがもっと出てくるだろう。
じゃ、パッケージを作成してみよう。注意点がいくつかあるけど、ソースコード中にコメントで記入しておいた。備忘録として。

(define (install-polynomial-package)
  ;;==============================
  ;;内部手続き
  ;;==============================

  ;;------------------------------
  ;;変数の表現
  ;述語
  (define (variable? x) (symbol? x))
  (define (same-variable? v1 v2)
    (and (variable? v1)
	 (variable? v2)
	 (eq? v1 v2)))

  ;;------------------------------
  ;;項の表現
  ;構成子（※ 項の表現は、'(次数 係数) という感じ。）
  (define (make-term order coeff) (list order coeff))
  ;選択子
  (define (order term) (car term))  ;次数
  (define (coeff term) (cadr term)) ;係数

  ;;------------------------------
  ;;項リストの表現
  ;選択子
  (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 (the-empty-termlist) '())
  (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 (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 (make-poly variable term-list)
    (cons variable term-list))
  ;選択子
  (define (variable p) (car p))  ;変数
  (define (term-list p) (cdr p)) ;項リスト
  ;加算
  (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))

こんなとこか。=zero?手続きが未定義だが、これは問題2.86で出題されているので次のエントリで作成しよう。