SICP 読み (78) 2.5.3 例: 記号代数

scheme SICP

現実トウヒな成果を。

問題 2.88

多項式な減算オペレータの定義。原文のヒントによれば

define a generic negation operation

とある。符号を反転させて加算すれば良いのな、と。とりあえず試験をいっこデッチ上げておいて実装検討。

#!/usr/bin/env gosh

(use test.unit)
(require "2.5.3")

(define-test-suite "2.5.3"

  ("2-88"
   (setup (lambda ()
	    (install-scheme-number-package)
	    (install-polynomial-package)))

   ("first (1x - 1x = 0)"
    (assert-true (=zero? (sub (make-polynomial 'x '((1 1)))
			      (make-polynomial 'x '((1 1))))))
    )
   )
-- 以下略 --

えーと、こんな感じ??

  (put 'sub '(polynomial polynomial)
       (lambda (p1 p2) (tag (add-poly p1 (neg p2)))))

neg という手続きも必要。

  (put 'neg '(polynomial)
       (lambda (p) (tag (neg-poly p))))

neg-poly は

(make-poly (variable p) (neg-terms (term-list p)))

で良い?

neg-terms は引数なリストの coeff を順に - すれば良いのかな??
面倒なので neg-poly 関連の手続きの下書きを以下に。

(define (neg-poly p)
  (make-poly (variable p)
	     (neg-terms (term-list p))))

(define (neg-terms L)
  (let f ((L L) (ret '()))
    (if (null? L)
	ret
	(f (cdr L) (cons (list (order (car L)) (- (coeff (car L)))) ret)))))

なんかごちゃごちゃしてるなぁ。盛り込んで試験してみる。

試験

で、上記を盛り込んで試験してみたのですが、失敗。以下のようにしたら通った。

 (put 'sub '(polynomial polynomial)
      (lambda (p1 p2) (tag (add-poly p1 (neg-poly p2)))))

汎用符号反転演算はドコに行ったんだ。これじゃ駄目だよ。
でも、符号の反転を汎用にするとしたら、sub という手続きに盛り込む形は取るべきではないのかなぁ。neg を使えば add を使って減算できますよ、みたいな??


自分勝手な理解ですが、そうする事に。なので

  • sub は定義しない
  • neg のみ定義

で試験は以下になりますか。

 ("2-88"
  (setup (lambda ()
           (install-scheme-number-package)
           (install-polynomial-package)))

  ("first (1x - 1x = 0)"
   (assert-true (=zero? (add (make-polynomial 'x '((1 1)))
                             (neg (make-polynomial 'x '((1 1)))))))
   )
  )

neg 手続きの定義は上記と同じですが、トップレベルで以下の記述が必要。

(define (neg x) (apply-generic 'neg x))

多項式と言いつつ単項の試験しかしてないので、試験の追加が必要。あ、0 に対して neg しちゃ駄目だな。判定は neg-terms ん中で、でしょうか。って 0 だったら 0 を返してるようにも見えるな。どちらにしても試験が足りてない。

で、以下の試験を追加してみると NG。

  ("2nd (1x - 0 = 1x)"
   (let ((p (make-polynomial 'x '((1 1)))))
     (assert-equal p (add p (neg (make-polynomial 'x '())))))
   )

  ("3rd (1x - 0x = 1x"
   (let ((p1 (make-polynomial 'x '((1 1))))
         (p0 (make-polynomial 'x '((1 0)))))
     (assert-equal p1 (add p1 (neg p0))))
   )

  ("4th polynomial neg"
   (let ((p1 (make-polynomial 'x '((3 1) (2 2) (1 3) (0 4))))
         (p2 (make-polynomial 'x '((3 -1) (2 -2) (1 -3) (0 -4)))))
     (assert-equal p1 (neg p2))
     (assert-equal p2 (neg p1)))
   )

最後の多項式なソレが逆になってるし。


mul-term-by-all-terms 手続きをパクッて以下のように修正。

 (define (neg-terms L)
   (if (empty-termlist? L)
       (the-empty-termlist)
       (let ((t (first-term L)))
         (adjoin-term
          (make-term (order t) (- (coeff t)))
          (neg-terms (rest-terms L)))))
   )

てきとーにやってるのバレバレだなぁ。自分ででっち上げずに、まず周囲を見なさい、が教訓か。肝に命じながらすぐに忘れてしまいます。(駄目

追記

しかし、negation って辞書引いたら「否定」なんだけど、和訳な本では「符号反転」になっています。うーん。