SICP 問題2.91（多項式の除算）

問題

一元多項式はもう一つのもので割り、多項式の商と多項式の剰余が得られる。例えば

$\frac{x^5-1}{x^2-1}=x^3+x,\,\,\,R...\,\,x-1$

除算は長い除算で実行される。つまり被除数の最高次の項を除数の最高次の項で割る。この結果が商の第一項である。次にこの結果に除数を掛け、それを被除数から引き、答えの残りは再帰的にこの差を除数で割って作る。除数の次数が被除数の次数を超えたら停止し、その被除数を剰余とせよ。また被除数がゼロになったら商と剰余の両方にゼロを返せ。
add-poly, mul-polyにならってdiv-polyを設計できる。手続きは二つの多項式が同じ変数を持つか調べる。そうであればdiv-polyは変数を剥がし、問題をdiv-termsに送る。それが項リストについて除算を行う。div-polyは最後にdiv-termsからもらった結果に変数を取り付ける。div-termsを除算の商と剰余の両方を計算するように設計すると便利である。div-termsは引数として二つの項リストを取り、商の項リストと剰余の小売すとのリストを返す。
次のdiv-termsの定義を欠けている式を補って完成せよ。これを使って、引数として二つの多項式をとり、商と剰余の多項式のリストを返すdiv-polyを実装せよ。

(define (div-terms L1 L2)
  (if (empty-termlist? L1)
      (list (the-empty-termlist) (the-empty-termlist))
      (let ((t1 (first-term L1))
	    (t2 (first-term L2)))
	(if (> (order t2) (order t1))
	    (list (the-empty-termlist) L1)
	    (let ((new-c (div (coeff t1) (coeff t2)))
		  (new-o (- (order t1) (order t2))))
	      (let ((rest-of-result <<結果の残りを再帰的に計算する>>))
		<<完全な結果を形勢する>>
		))))))

解答

アルゴリズムがよくわからねぇ。文章を分解してソースに張り付けていってみよう。



０．除算は長い除算で実行される。

１．つまり被除数の最高次の項を除数の最高次の項で割る。

２．この結果が商の第一項である。

３．次にこの結果に除数を掛け、それを被除数から引き、答えの残りは再帰的にこの差を除数で割って作る。

４．除数の次数が被除数の次数を超えたら停止し、その被除数を剰余とせよ。

５．また被除数がゼロになったら商と剰余の両方にゼロを返せ。

こんな感じ？ソースのどこに該当するか・・・

;L1：被除数
;L2：除数

(define (div-terms L1 L2)
  (if (empty-termlist? L1)
      (list (the-empty-termlist) (the-empty-termlist))
      (let (;被除数の最高次の項を取得
            (t1 (first-term L1))
            ;除数の最高次の項を取得
	    (t2 (first-term L2)))
	;４．除数の次数が被除数の次数を超えたら停止し、その被除数を剰余とせよ。
	(if (> (order t2) (order t1))
	    (list (the-empty-termlist) L1) ;2番目のアイテムが剰余
	    ;１．つまり被除数の最高次の項を除数の最高次の項で割る。
            ;２．この結果が商の第一項である。
	    (let ((new-c (div (coeff t1) (coeff t2))) ;係数の除算
		  (new-o (- (order t1) (order t2))))  ;次数の除算
	      ;３．次にこの結果に除数を掛け、それを被除数から引き、答えの残りは再帰的にこの差を除数で割って作る。
	      (let ((rest-of-result (sub-terms L1 (mul-term-by-all-terms (make-term new-o new-c) L2))))
		       (modulo (cadr answer)))
		(let* ((answer (div-terms rest-of-result L2))    ;リストの第2項に剰余が格納された形で返却されてくる。
		       (quotient (car answer))                   ;第1項である商を取得
		       (modulo (cadr answer)))　　　　　　　　   ;第2項以降の剰余を取得
		  (list (cons (make-term new-o new-c) quotient) 　;商を加算して戻っていく。
			modulo)))))))                            ;剰余はそのまま返却

こんな感じか？
で、そもそもこのdiv-termsは薄い多項式用のやつだから、薄い多項式のファイルに定義することになる。薄い多項式の*-termsの呼び出し方はほとんど同じなので、汎用手続き「*-terms」を作ってまとめてしまった。そのファイルを掲載しよう。手を加えた箇所にコメントしとく。

calculate-polynomial-light.scm

(use srfi-1)

(define (install-polynomial-light-package)
  (define (tag p)
    (attach-tag 'light p))
  (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 (sub-terms L1 L2)
    (define (reverse-signs terms)
      (map (lambda (term)
	     (make-term (order term) (* -1 (coeff term))))
	   terms))
    (add-terms L1
	       (reverse-signs 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 (div-terms L1 L2)
    (if (empty-termlist? L1)
	(list (the-empty-termlist) (the-empty-termlist))
	(let ((t1 (first-term L1))
	      (t2 (first-term L2)))
	  (if (> (order t2) (order t1))
	      (list (the-empty-termlist) L1)
	      (let ((new-c (div (coeff t1) (coeff t2)))
		    (new-o (- (order t1) (order t2))))
		(let ((rest-of-result (sub-terms L1 (mul-term-by-all-terms (make-term new-o new-c) L2))))
		  (let* ((answer (div-terms rest-of-result L2))
			 (quotient (car answer))
			 (modulo (cadr answer)))
		    (list (cons (make-term new-o new-c) quotient)
			  modulo))))))))
  ;;------------------------------

  (define (make-poly variable term-list)
    (cons variable term-list))
  (define (variable p) (car p))
  (define (term-list p) (cdr p))

  ;;------------------------------
  ;;汎用演算手続き
  (define (*-poly make-proc calc-proc p1 p2)
    (if (same-variable? (variable p1) (variable p2))
	(make-proc (variable p1)
		   (calc-proc (term-list p1)
			      (term-list p2)))
	(error "Polys not in same var -- "
	       (x->string proc)
	       (list p1 p2))))
  ;;------------------------------

  ;;------------------------------
  ;;加算、減算、乗算用の多項式生成用共通手続き
  (define (*-make-poly var result)
    (make-poly var result))
  ;;------------------------------

  ;;------------------------------
  ;;加算、減算、乗算の定義を変更（汎用）手続きを使用する。
  (define (add-poly p1 p2)
    (*-poly *-make-poly add-terms p1 p2))
  (define (sub-poly p1 p2)
    (*-poly *-make-poly sub-terms p1 p2))
  (define (mul-poly p1 p2)
    (*-poly *-make-poly mul-terms p1 p2))
  ;;------------------------------

  ;;------------------------------
  ;;多項式の除算手続き
  (define (div-poly p1 p2)
    (*-poly (lambda (var result)
	      (map (lambda (item)
		     (make-poly var item))
		   result))
	    div-terms
	    p1
	    p2))
  ;;------------------------------

  (define (=zero-poly? polynomial)
    (define (coeff-list term-list)
      (filter-map (lambda (x)
		    (not (=zero? (coeff x))))
		  term-list))
    (let ((terms (term-list polynomial)))
      (cond ((empty-termlist? terms)
	     #t)
	    ((null? (coeff-list terms))
	     #t)
	    (else
	     #f))))

  (put 'add-poly '(light light)
       (lambda (p1 p2)
	 (tag (add-poly p1 p2))))
  (put 'sub-poly '(light light)
       (lambda (p1 p2)
	 (tag (sub-poly p1 p2))))
  (put 'mul-poly '(light light)
       (lambda (p1 p2)
	 (tag (mul-poly p1 p2))))

  ;;------------------------------
  ;;公開用除算手続きを
  (put 'div-poly '(light light)
       (lambda (p1 p2)
	 (map tag (div-poly p1 p2))))
  ;;------------------------------

  (put '=zero-poly? 'light
       (lambda (p)
	 (=zero-poly? p)))
  (put 'make-polynomial-light 'light
       (lambda (var terms)
	 (tag (make-poly var terms))))
  (put 'coerce 'light
       (lambda (poly)
	 poly))
  'done)
(install-polynomial-light-package)

続いて濃い多項式の表現でも計算できるようにしちゃう。calculate-polynomial-heavy.scmをこんな感じで修正。（例によって追加、修正した箇所をコメントで注釈。コメントって注釈って意味だっけ？）

calculate-polynomial-heavy.scm

(use srfi-1)

(define (install-polynomial-heavy-package)
  (define (variable? x)
    (symbol? x))
  (define (same-variable? v1 v2)
    (and (variable? v1)
	 (variable? v2)
	 (eq? v1 v2)))
  (define (tag p)
    (attach-tag 'heavy p))

  
  (define (make-poly variable highest-order coeffs)
    (cons variable (cons highest-order coeffs)))
  (define (variable p) (car p))
  (define (terms p) (cdr p))

  ;;------------------------------
  ;;空の多項式
  (define the-empty-termlist (make-terms 0 '()))
  ;;------------------------------


  (define (make-terms highest-order coeffs)
    (cons highest-order coeffs))
  (define (make-terms-padding high low terms)
    (let ((h (highest-order terms))
	  (l (lowest-order terms)))
      (if (or (< high h) (< l low))
	  (error "Illegal highest-order or lowest-order.")
	  (let ((h-pad (iota (- high h) 0 0))
		(l-pad (iota (- l low) 0 0)))
	    (cons high (append h-pad (coeffs terms) l-pad))))))
  (define (coeffs t)
    (cdr t))
  (define (highest-order t)
    (car t))
  (define (lowest-order t)
    (+ (- (highest-order t)
	  (length (coeffs t)))
       1))

  
  ;;------------------------------
  ;;正規化（最高次元、最低次元の係数が０だった場合、その係数を削除）
  (define (regulate-terms t)
    (define (cut-zero number-list)
      (let loop ((count 0)
		 (numbers number-list))
	(if (=zero? (car numbers))
	    (loop (+ 1 count) (cdr numbers))
	    (list count numbers))))
    (let* ((h-order (highest-order t))
	   (coeff-list (coeffs t))
	   (result1 (cut-zero coeff-list))
	   (h-order1 (- h-order (car result1)))
	   (coeff-list1 (cadr result1))
	   (coeff-list2 (reverse (cadr (cut-zero (reverse coeff-list1))))))
      (make-terms h-order1 coeff-list2)))
  ;;------------------------------
      


  (define (+/-terms +/- terms1 terms2)
    (let* ((h-order (max (highest-order terms1)
			 (highest-order terms2)))
	   (l-order (min (lowest-order terms1)
			 (lowest-order terms2)))
	   (p-terms1 (make-terms-padding h-order l-order terms1))
	   (p-terms2 (make-terms-padding h-order l-order terms2)))
      (make-terms h-order (map (lambda (c1 c2)
				 (+/- c1 c2))
			       (coeffs p-terms1)
			       (coeffs p-terms2)))))
  (define (add-terms terms1 terms2)
    (+/-terms + terms1 terms2))
  (define (sub-terms terms1 terms2)
    (+/-terms - terms1 terms2))
  (define (mul-terms terms1 terms2)
    (let ((high1 (highest-order terms1))
	  (high2 (highest-order terms2))
	  (coeffs1 (coeffs terms1))
	  (coeffs2 (coeffs terms2)))
      (let loop ((current-order high2)
		 (current-coeffs coeffs2)
		 (ans-terms (make-terms 0 '())))
	(cond ((null? current-coeffs)
	       ans-terms)
	      ((=zero? (car current-coeffs))
	       (loop (- current-order 1)
		     (cdr current-coeffs)
		     ans-terms))
	      (else
	       (loop (- current-order 1)
		     (cdr current-coeffs)
		     (add-terms ans-terms
				(make-terms (+ high1 current-order)
					    (map (lambda (x)
						   (* x (car current-coeffs)))
						 coeffs1)))))))))
  ;;------------------------------
  ;;項リストの除算を行う手続き
  (define (div-terms L1 L2)
    (let ((h-order1 (highest-order L1))
	  (h-order2 (highest-order L2))
	  (coeffs1 (coeffs L1))
	  (coeffs2 (coeffs L2)))
      (if (< h-order1 h-order2)
	  (list the-empty-termlist L1)
	  (let ((new-c (div (car coeffs1) (car coeffs2)))
		(new-o (- h-order1 h-order2)))
	    (let* ((target-term (make-terms new-o (list new-c)))
		   (rest-of-result (regulate-terms (sub-terms L1 (mul-terms target-term L2)))))
	      (let* ((answer (div-terms rest-of-result L2))
		     (quotient (car answer))
		     (modulo (cadr answer)))
		(list (add-terms target-term quotient)
		      modulo)))))))
  ;;------------------------------


  ;;------------------------------
  ;;多項式の汎用演算手続きをさらに汎用化
  (define (*-poly make-proc calc-proc p1 p2)
    (if (same-variable? (variable p1)
			(variable p2))
	(make-proc (variable p1)
		   (calc-proc (terms p1)
			      (terms p2)))
	(error "Polys not in same var -- "
	       (x->string calc-proc)
	       (list p1 p2))))
  ;;------------------------------


  ;;------------------------------
  ;;加算、減算、乗算用の汎用項リスト生成手続き
  (define (*-make-poly var result)
    (make-poly var
	       (highest-order result)
	       (coeffs result)))
  ;;------------------------------


  ;;------------------------------
  ;;多項式の演算手続きにて、更に汎用化した演算手続きを使用するように変更
  (define (add-poly p1 p2)
    (*-poly *-make-poly add-terms p1 p2))
  (define (sub-poly p1 p2)
    (*-poly *-make-poly sub-terms p1 p2))
  (define (mul-poly p1 p2)
    (*-poly *-make-poly mul-terms p1 p2))
  ;;------------------------------

  ;;------------------------------
  ;;多項式の除算手続き
  (define (div-poly p1 p2)
    (*-poly (lambda (var result)
	      (map (lambda (item)
		     (make-poly var
				(highest-order item)
				(coeffs item)))
		   result))
	    div-terms
	    p1
	    p2))
  ;;------------------------------


  (define (=zero-poly? p)
    (let* ((ts (terms p))
	   (cs (coeffs ts))
	   (filterd (filter-map (lambda (x)
				  (not (=zero? x)))
				cs)))
      (null? filterd)))


  (put 'add-poly '(heavy heavy)
       (lambda (p1 p2)
	 (tag (add-poly p1 p2))))
  (put 'sub-poly '(heavy heavy)
       (lambda (p1 p2)
	 (tag (sub-poly p1 p2))))
  (put 'mul-poly '(heavy heavy)
       (lambda (p1 p2)
	 (tag (mul-poly p1 p2))))


  ;;------------------------------
  ;;公開用の多項式の除算手続き
  (put 'div-poly '(heavy heavy)
       (lambda (p1 p2)
	 (map tag (div-poly p1 p2))))
  ;;------------------------------


  (put '=zero-poly? 'heavy
       (lambda (p)
	 (=zero-poly? p)))
  (put 'make-polynomial-heavy 'heavy
       (lambda (var highest-order coeffs)
	 (tag (make-poly var highest-order coeffs))))
  (put 'coerce 'heavy
       (lambda (poly)
	 (let* ((p (contents poly))
		(var (variable p))
		(term-list (terms p))
		(h-order (highest-order term-list))
		(coeff-list (coeffs term-list))
		(orders (iota (length coeff-list)
			      h-order
			      -1)))
	   ((get 'make-polynomial-light 'light)
	    var
	    (map (lambda (order coeff)
		   (list order coeff))
		 orders
		 coeff-list)))))
  'done)
(install-polynomial-heavy-package)

よし、じゃあ多項式の除算テストを追記したテストスクリプトを。。

(define (calculate-polynomial-test)
  (define (make-polynomial-*-test)
    (define (print-test-light answer var terms)
      (let ((p (make-polynomial-light var terms)))
    	(if (equal? p answer)
    	    (print "[ O K ] (print-test-light " var " " terms ")")
    	    (begin
    	      (print "[ERROR] (print-test-light " var " " terms ")")
    	      (print " result:" p)
    	      (print " answer:" answer)))))
    (define (print-test-heavy answer var highest-order coeffs)
      (let ((p (make-polynomial-heavy var highest-order coeffs)))
    	(if (equal? p answer)
    	    (print "[ O K ] (print-test-heavy "
    		   var " " highest-order " " coeffs ")")
    	    (begin
    	      (print "[ERROR] (print-test-heavy "
    		     var " " highest-order " " coeffs ")")
    	      (print " result:" p)
    	      (print " answer:" answer)))))

    (print "<<構成子のテスト>>")
    (print-test-light '(polynomial light x (3 2) (2 1) (0 4))
    		      'x '((3 2) (2 1) (0 4)))
    (print-test-heavy '(polynomial heavy x 5 1 2 0 4 -2 1)
    		      'x 5 '(1 2 0 4 -2 1))
    )


  (define (=zero?-test)
    (define (print-test answer p)
      (let ((result (=zero? p)))
  	(if (equal? result answer)
  	    (print "[ O K ] " p)
  	    (begin
  	      (print "[ERROR] " p)
  	      (print " result:" result)
  	      (print " answer:" answer)))))

    (print "<<ゼロ確認>>")
    (print-test #f (make-polynomial-light 'x '((3 1) (2 1) (1 1) (0 1))))
    (print-test #f (make-polynomial-light 'x '((3 1) (2 1) (1 1) (0 0))))
    (print-test #f (make-polynomial-light 'x '((3 1) (2 1) (1 0) (0 0))))
    (print-test #f (make-polynomial-light 'x '((3 1) (2 0) (1 0) (0 0))))
    (print-test #t (make-polynomial-light 'x '((3 0) (2 0) (1 0) (0 0))))

    (print-test #f (make-polynomial-heavy 'x 3 '(1 1 1 1)))
    (print-test #f (make-polynomial-heavy 'x 3 '(1 1 1 0)))
    (print-test #f (make-polynomial-heavy 'x 3 '(1 1 0 0)))
    (print-test #f (make-polynomial-heavy 'x 3 '(1 0 0 0)))
    (print-test #t (make-polynomial-heavy 'x 3 '(0 0 0 0))))


  (define (add-test)
    (define (print-test answer p1 p2)
      (let ((result (add p1 p2)))
  	(if (equal? result answer)
  	    (print "[ O K ] " result)
  	    (begin
  	      (print "[ERROR] ")
  	      (print " p1    :" p1)
  	      (print " p2    :" p2)
  	      (print " result:" result)
  	      (print " answer:" answer)))))

    (print "<<加算>>")
    (print-test (make-polynomial-light 'x '((3 1) (2  1) (1 -2) (0 1)))
		(make-polynomial-light 'x '(      (2  2) (1 -3) (0 1)))
		(make-polynomial-light 'x '((3 1) (2 -1) (1  1))))
    (print-test (make-polynomial-heavy 'x 3 '(1 1 -2 1))
		(make-polynomial-heavy 'x 2 '(2 -3 1))
		(make-polynomial-heavy 'x 3 '(1 -1 1)))
    (print-test (make-polynomial-light 'x '((3 1) (2  1) (1 -2) (0 1)))
		(make-polynomial-heavy 'x 2 '(2 -3 1))
		(make-polynomial-light 'x '((3 1) (2 -1) (1  1))))
    (print-test (make-polynomial-light 'x '((3 1) (2  1) (1 -2) (0 1)))
		(make-polynomial-light 'x '((3 1) (2 -1) (1  1)))
		(make-polynomial-heavy 'x 2 '(2 -3 1)))
    )


  (define (sub-test)
    (define (print-test answer p1 p2)
      (let ((result (sub p1 p2)))
  	(if (equal? result answer)
  	    (print "[ O K ] " result)
  	    (begin
  	      (print "[ERROR] ")
  	      (print " p1    :" p1)
  	      (print " p2    :" p2)
  	      (print " result:" result)
  	      (print " answer:" answer)))))

    (print "<<減算>>")
    (print-test (make-polynomial-light 'x '((3 -1) (2  3) (1 -4) (0 1)))
		(make-polynomial-light 'x '(       (2  2) (1 -3) (0 1)))
		(make-polynomial-light 'x '((3 1)  (2 -1) (1  1))))
    (print-test (make-polynomial-heavy 'x 3 '(-1  3 -4 1))
		(make-polynomial-heavy 'x 2 '(    2 -3 1))
		(make-polynomial-heavy 'x 3 '( 1 -1  1)))
    (print-test (make-polynomial-light 'x '((3 -1) (2  3) (1 -4) (0 1)))
		(make-polynomial-heavy 'x 2 '(2 -3 1))
		(make-polynomial-light 'x '((3 1) (2 -1) (1  1))))
    (print-test (make-polynomial-light 'x '((3 1) (2  -3) (1 4) (0 -1)))
		(make-polynomial-light 'x '((3 1) (2 -1) (1  1)))
		(make-polynomial-heavy 'x 2 '(2 -3 1)))
    )

  (define (mul-test)
    (define (print-test answer p1 p2)
      (let ((result (mul p1 p2)))
  	(if (equal? result answer)
  	    (print "[ O K ] " result)
  	    (begin
  	      (print "[ERROR] ")
  	      (print " p1    :" p1)
  	      (print " p2    :" p2)
  	      (print " result:" result)
  	      (print " answer:" answer)))))

    (print "<<乗算>>")
    (print-test (make-polynomial-light 'x '((5 2) (4 -5) (3 6) (2 -4) (1 1)))
		(make-polynomial-light 'x '((2 2) (1 -3) (0 1)))
		(make-polynomial-light 'x '((3 1) (2 -1) (1 1))))
    (print-test (make-polynomial-heavy 'x 5 '(2 -5 6 -4 1))
		(make-polynomial-heavy 'x 2 '(2 -3 1))
		(make-polynomial-heavy 'x 3 '(1 -1 1)))
    (print-test (make-polynomial-light 'x '((5 2) (4 -5) (3 6) (2 -4) (1 1)))
		(make-polynomial-heavy 'x 2 '(2 -3 1))
		(make-polynomial-light 'x '((3 1) (2 -1) (1 1))))
    (print-test (make-polynomial-light 'x '((5 2) (4 -5) (3 6) (2 -4) (1 1)))
		(make-polynomial-light 'x '((3 1) (2 -1) (1 1)))
		(make-polynomial-heavy 'x 2 '(2 -3 1)))
    )

  ;------------------------------
  ;除算テスト
  (define (div-test)
    (define (print-test answer p1 p2)
      (let ((result (div p1 p2)))
  	(if (equal? result answer)
  	    (print "[ O K ] " result)
  	    (begin
  	      (print "[ERROR] ")
  	      (print " p1    :" p1)
  	      (print " p2    :" p2)
  	      (print " result:" result)
  	      (print " answer:" answer)))))

    (print "<<除算>>")
    ;;薄い多項式同士
    (print-test (list (make-polynomial-light 'x '((3 1) (1 1)))
		      (make-polynomial-light 'x '((1 1) (0 -1))))
		(make-polynomial-light 'x '((5 1) (0 -1)))
		(make-polynomial-light 'x '((2 1) (0 -1))))
    ;;濃い多項式同士
    (print-test (list (make-polynomial-heavy 'x 3 '(1 0 1))
		      (make-polynomial-heavy 'x 1 '(1 -1)))
		(make-polynomial-heavy 'x 5 '(1 0 0 0 0 -1))
		(make-polynomial-heavy 'x 2 '(1 0 -1)))
    ;;薄い多項÷濃い多項式
    (print-test (list (make-polynomial-light 'x '((3 1) (1 1)))
		      (make-polynomial-light 'x '((1 1) (0 -1))))
		(make-polynomial-light 'x '((5 1) (0 -1)))
		(make-polynomial-heavy 'x 2 '(1 0 -1)))
    ;;濃い多項式÷薄い多項
    (print-test (list (make-polynomial-light 'x '((3 1) (1 1)))
		      (make-polynomial-light 'x '((1 1) (0 -1))))
		(make-polynomial-heavy 'x 5 '(1 0 0 0 0 -1))
		(make-polynomial-light 'x '((2 1) (0 -1))))
    )

  (make-polynomial-*-test)
  (=zero?-test)
  (add-test)
  (sub-test)
  (mul-test)
  (div-test)
)

テストケース少なすぎ？まぁテストを繰り返してできる環境を作っておくのが大事なので、テストが少ないのは多めにみてやってくださいな。。
では実験。



gosh> (calculate-polynomial-test)<<構成子のテスト>>

[ O K ] (print-test-light x ((3 2) (2 1) (0 4)))

　　・

　　・

　　・<<除算>>

[ O K ] ((polynomial light x (3 1) (1 1)) (polynomial light x (1 1) (0 -1)))

[ O K ] ((polynomial heavy x 3 1 0 1) (polynomial heavy x 1 1 -1))

[ O K ] ((polynomial light x (3 1) (1 1)) (polynomial light x (1 1) (0 -1)))

[ O K ] ((polynomial light x (3 1) (1 1)) (polynomial light x (1 1) (0 -1)))

#

gosh>

よっしゃ！できた！ということにして次へいこうっと。