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

問題 2.92 はスルー。あと 5 問で 2 章が終わるんですが、残りの 3 頁が見るからに重たそう。ってか一番重いの 2.92 なんだろうな。

問題 2.93

まず、問題 2.88 を流用して有理数なソレを盛り込む。現時点で include はしてるんですが、仕様通りの実装にはなっていないハズ。

(define (install-rational-package)
 ;; internal procedures
 (define (numer x) (car x))
 (define (denom x) (cdr x))
 (define (make-rat n d)
   (let ((g (gcd n d)))
     (cons (/ n g) (/ d g))))
 (define (add-rat x y)
   (make-rat (+ (* (numer x) (denom y))
                (* (numer y) (denom x)))
             (* (denom x) (denom y))))
 (define (sub-rat x y)
   (make-rat (- (* (numer x) (denom y))
                (* (numer y) (denom x)))
             (* (denom x) (denom y))))
 (define (mul-rat x y)
   (make-rat (* (numer x) (numer y))
             (* (denom x) (denom y))))
 (define (div-rat x y)
   (make-rat (* (numer x) (denom y))
             (* (denom x) (numer y))))
 ;; interface to rest of the system
 (define (tag x) (attach-tag 'rational x))
 (put 'add '(rational rational)
      (lambda (x y) (tag (add-rat x y))))
 (put 'sub '(rational rational)
      (lambda (x y) (tag (sub-rat x y))))
 (put 'mul '(rational rational)
      (lambda (x y) (tag (mul-rat x y))))
 (put 'div '(rational rational)
      (lambda (x y) (tag (div-rat x y))))

 (put 'make 'rational
      (lambda (n d) (tag (make-rat n d))))
 'done)
(define (make-rational n d)
 ((get 'make 'rational) n d))

make-rat を変更し、とあるな。単純に cons するだけにしておけば動く??

上記実装 (make-rat は変更) を以下の試験で確認。

 ("include rational package"
  (setup (lambda ()
           (install-rational-package)
           (install-scheme-number-package)
           (install-polynomial-package)))
  ("sample"
   (let ((p1 (make-polynomial 'x '((2 1) (0 1))))
         (p2 (make-polynomial 'x '((3 1) (0 1)))))
     (let ((rf (make-rational p2 p1)))
       (assert-equal 'rational (car rf))
       (assert-equal p2 (cadr rf))
       (assert-equal p1 (cddr rf))
       ))
   )
  )

一応動いている。次は (add rf rf) で約分されていない事を確認か。assert を追加。

 ("include rational package"
  (setup (lambda ()
           (install-rational-package)
           (install-scheme-number-package)
           (install-polynomial-package)))
  ("sample"
   (let ((p1 (make-polynomial 'x '((2 1) (0 1))))
         (p2 (make-polynomial 'x '((3 1) (0 1)))))
     (let ((rf (make-rational p2 p1)))
       (assert-equal 'rational (car rf))
       (assert-equal p2 (cadr rf))
       (assert-equal p1 (cddr rf))
       (let ((test (add rf rf)))
         (assert-equal 'rational (car test))
         (assert-equal p1 (cddr test))
         (assert-equal (add p2 p2) (cadr test))
         )
       ))
   )
  )

試験してみると NG との事。

-- (test case) include rational package: E
./test/test-2.5.3.scm:20: (add rf rf)
Error occurred in sample
*** ERROR: operation * is not defined between (polynomial x (3 1) (0 1)) and (polynomial x (2 1) (0 1))
./test/test-2.5.3.scm:20: (add rf rf)

演算子が + とか * とかになってるからか。- もあるが neg して add すれば OK ですな。上記の試験がビンゴなのかどうか、は実装を修正しないと分からん。(を

で、試験してみたんですが、上記の試験では NG。_分数を最低項まで引き下げ_んというのはこれですか。本来であれば

ではなくて

にならないとイケないんだな。でも今の実装ではそれは無理。(add rf rf) です。

修正した試験が以下。

 ("include rational package"
  (setup (lambda ()
           (install-rational-package)
           (install-scheme-number-package)
           (install-polynomial-package)))
  ("sample"
   (let ((p1 (make-polynomial 'x '((2 1) (0 1))))
         (p2 (make-polynomial 'x '((3 1) (0 1)))))
     (let ((rf (make-rational p2 p1)))
       (assert-equal 'rational (car rf))
       (assert-equal p2 (cadr rf))
       (assert-equal p1 (cddr rf))
       (let ((test (add rf rf)))
         (assert-equal 'rational (car test))
         (assert-equal (make-polynomial 'x '((4 1) (2 2) (0 1)))
                       (cddr test))
         (assert-equal (make-polynomial 'x '((5 2) (3 2) (2 2) (0 2)))
                       (cadr test))
         )
       ))
   )
  )

あと、修正した rational-package が以下。

(define (install-rational-package)
 ;; internal procedures
 (define (numer x) (car x))
 (define (denom x) (cdr x))
 (define (make-rat n d)
;    (let ((g (gcd n d)))
;      (cons (/ n g) (/ d g))))
   (cons n d))
 (define (add-rat x y)
   (make-rat (add (mul (numer x) (denom y))
                  (mul (numer y) (denom x)))
             (mul (denom x) (denom y))))
 (define (sub-rat x y)
   (make-rat (add (mul (numer x) (denom y))
                  (neg (mul (numer y) (denom x))))
             (mul (denom x) (denom y))))
 (define (mul-rat x y)
   (make-rat (mul (numer x) (numer y))
             (mul (denom x) (denom y))))
 (define (div-rat x y)
   (make-rat (mul (numer x) (denom y))
             (mul (denom x) (numer y))))
 ;; interface to rest of the system
 (define (tag x) (attach-tag 'rational x))
 (put 'add '(rational rational)
      (lambda (x y) (tag (add-rat x y))))
 (put 'sub '(rational rational)
      (lambda (x y) (tag (sub-rat x y))))
 (put 'mul '(rational rational)
      (lambda (x y) (tag (mul-rat x y))))
 (put 'div '(rational rational)
      (lambda (x y) (tag (div-rat x y))))

 (put 'make 'rational
      (lambda (n d) (tag (make-rat n d))))
 'done)
(define (make-rational n d)
 ((get 'make 'rational) n d))

一応、手を入れた手続きについては試験をしておいた方が良いな。

追記

試験を作成。微妙だったのは scheme-number なパケジに neg 演算が無かったコト。最初、rational なパケジに neg を定義してしまい、微妙にハマる。

手を入れた scheme-number-package を以下に。

(define (install-scheme-number-package)
 (put 'add '(scheme-number scheme-number) +)

 (put 'sub '(scheme-number scheme-number) -)

 (put 'mul '(scheme-number scheme-number) *)

 (put 'div '(scheme-number scheme-number) /)

 (put 'neg '(scheme-number) -)

 (put '=zero? '(scheme-number) zero?)

 (put 'make 'scheme-number
      (lambda (x) x))
 'done)

(define (make-scheme-number n)
 ((get 'make 'scheme-number) n))

で、演算子の試験が以下。簡単に済ませスギかも。

  ("rational package (add)"
   (let ((r1 (make-rational 1 2))
	 (r2 (make-rational 1 3)))
     (let ((result (add r1 r2)))
       (assert-equal 'rational (car result))
       (assert-equal 5 (cadr result))
       (assert-equal 6 (cddr result))))
   )

  ("rational package (sub)"
   (let ((r1 (make-rational 1 2))
	 (r2 (make-rational 1 3)))
     (let ((result (sub r1 r2)))
       (assert-equal 'rational (car result))
       (assert-equal 1 (cadr result))
       (assert-equal 6 (cddr result))))
   )

  ("rational package (mul)"
   (let ((r1 (make-rational 1 2))
	 (r2 (make-rational 1 3)))
     (let ((result (mul r1 r2)))
       (assert-equal 'rational (car result))
       (assert-equal 1 (cadr result))
       (assert-equal 6 (cddr result))))
   )

  ("rational package (div)"
   (let ((r1 (make-rational 1 2))
	 (r2 (make-rational 1 3)))
     (let ((result (div r1 r2)))
       (assert-equal 'rational (car result))
       (assert-equal 3 (cadr result))
       (assert-equal 2 (cddr result))))
   )

一応パスしてると見て、remainder-terms の検討に着手か。2.91 の流用という部分で言えば、2.94 はさほどハードルは高くないな。がしかし、それ以降が微妙。