わはは

SICP scheme

問題 2.1 の以前の回答を確認してみたら大ウソ。これは無いなぁ。
とりあえず試験をナニ。add-rat の続きから。そういえば gcd の試験とか numer だの denom だのな試験も書いておく必要あり。
以下を追加。

(test-section "gcd")
(test* "(gcd 5 0)"
       5
       (gcd 5 0))

(test* "(gcd 2 3)"
       1
       (gcd 2 3))

(test* "(gcd 3 6)"
       3
       (gcd 3 6))

(test* "(gcd -3 6)"
       -3
       (gcd -3 6))

(test-section "numer")
(test* "(numer '(1 . 2))"
       1
       (numer '(1 . 2)))

(test-section "denom")
(test* "(denom '(1 . 2))"
       2
       (denom '(1 . 2)))

前にこのあたりをヤッた時には gaunit を使っていたんだな。gauche.test の存在を知らなかったという物凄いオチなんですが。
以下な Makefile を書いておけば

SHELL=/bin/sh

TARGET=$(wildcard test-*.scm)

test:
	@rm -f test.log
	@for X in $(TARGET) ; do gosh $$X >> test.log ; done

clean:
	rm -rf *~ test.log

emacs 上で M-x compile で make が動いて試験な標準出力を emacs 上で確認できます。

add-rat の試験

以下なカンジで良いのだろうか。

(test-section "add-rat")
(test* "(+ 1/2 1/3)"
       '(5 . 6)
       (add-rat (make-rat 1 2) (make-rat 1 3)))

(test* "(+ -1/2 1/3)"
       '(-1 . 6)
       (add-rat (make-rat -1 2) (make-rat 1 3)))

(test* "(+ 1/-2 1/3)"
       '(-1 . 6)
       (add-rat (make-rat 1 -2) (make-rat 1 3)))

(test* "(+ 1/2 -1/3)"
       '(1 . 6)
       (add-rat (make-rat 1 2) (make-rat -1 3)))

(test* "(+ 1/2 1/-3)"
       '(1 . 6)
       (add-rat (make-rat 1 2) (make-rat 1 -3)))

sub も mul も div も上記コピペベースで試験書いちゃって良いかなぁ。

(test-section "sub-rat")
(test* "(- 1/2 1/3)"
       '(1 . 6)
       (sub-rat (make-rat 1 2) (make-rat 1 3)))

(test* "(- -1/2 1/3)"
       '(-5 . 6)
       (sub-rat (make-rat -1 2) (make-rat 1 3)))

(test* "(+ 1/-2 1/3)"
       '(-5 . 6)
       (sub-rat (make-rat 1 -2) (make-rat 1 3)))

(test* "(- 1/2 -1/3)"
       '(5 . 6)
       (sub-rat (make-rat 1 2) (make-rat -1 3)))

(test* "(- 1/2 1/-3)"
       '(5 . 6)
       (sub-rat (make-rat 1 2) (make-rat 1 -3)))

(test-section "mul-rat")
(test* "(* 1/2 1/3)"
       '(1 . 6)
       (mul-rat (make-rat 1 2) (make-rat 1 3)))

(test* "(* -1/2 1/3)"
       '(-1 . 6)
       (mul-rat (make-rat -1 2) (make-rat 1 3)))

(test* "(* 1/-2 1/3)"
       '(-1 . 6)
       (mul-rat (make-rat 1 -2) (make-rat 1 3)))

(test* "(* 1/2 -1/3)"
       '(-1 . 6)
       (mul-rat (make-rat 1 2) (make-rat -1 3)))

(test* "(* 1/2 1/-3)"
       '(-1 . 6)
       (mul-rat (make-rat 1 2) (make-rat 1 -3)))

(test-section "div-rat")
(test* "(/ 1/2 1/3)"
       '(3 . 2)
       (div-rat (make-rat 1 2) (make-rat 1 3)))

(test* "(/ -1/2 1/3)"
       '(-3 . 2)
       (div-rat (make-rat -1 2) (make-rat 1 3)))

(test* "(/ 1/-2 1/3)"
       '(-3 . 2)
       (div-rat (make-rat 1 -2) (make-rat 1 3)))

(test* "(/ 1/2 -1/3)"
       '(-3 . 2)
       (div-rat (make-rat 1 2) (make-rat -1 3)))

(test* "(/ 1/2 1/-3)"
       '(-3 . 2)
       (div-rat (make-rat 1 2) (make-rat 1 -3)))

一応試験パス。equal-rat? な試験は以下。

(test-section "equal-rat?")
(test* "(= 1/2 1/3)"
       #f
       (equal-rat? (make-rat 1 2) (make-rat 1 3)))

(test* "(= 1/2 1/2)"
       #t
       (equal-rat? (make-rat 1 2) (make-rat 1 2)))

(test* "(= 1/2 2/4)"
       #t
       (equal-rat? (make-rat 1 2) (make-rat 2 4)))

一応、実装と試験を以下に全部ナニ。
2.1.scm

(define (gcd a b)
  (if (= b 0)
      a
      (gcd b (remainder a b))))

(define (make-rat n d)
  (let ((n (if (and (> 0 d) (< 0 n)) (* -1 n) n))
	(d (abs d)))
    (let ((g (abs (gcd n d))))
      (cons (/ n g) (/ d g)))))
(define (numer x) (car x))
(define (denom x) (cdr x))

(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))))
(define (equal-rat? x y)
  (= (* (numer x) (denom y))
     (* (numer y) (denom x))))

test-2.1.scm

(use gauche.test)

(add-load-path ".")
(load "2.1")

(test-start "rational")
(test-section "gcd")
(test* "(gcd 5 0)"
       5
       (gcd 5 0))

(test* "(gcd 2 3)"
       1
       (gcd 2 3))

(test* "(gcd 3 6)"
       3
       (gcd 3 6))

(test* "(gcd -3 6)"
       -3
       (gcd -3 6))

(test-section "make-rat")
(test* "3/3"
       '(1 . 1)
       (make-rat 3 3))

(test* "-3/3"
       '(-1 . 1)
       (make-rat -3 3))

(test* "3/-3"
       '(-1 . 1)
       (make-rat 3 -3))

(test* "-3/-3"
       '(-1 . 1)
       (make-rat -3 -3))

(test-section "numer")
(test* "(numer '(1 . 2))"
       1
       (numer '(1 . 2)))

(test-section "denom")
(test* "(denom '(1 . 2))"
       2
       (denom '(1 . 2)))

(test-section "add-rat")
(test* "(+ 1/2 1/3)"
       '(5 . 6)
       (add-rat (make-rat 1 2) (make-rat 1 3)))

(test* "(+ -1/2 1/3)"
       '(-1 . 6)
       (add-rat (make-rat -1 2) (make-rat 1 3)))

(test* "(+ 1/-2 1/3)"
       '(-1 . 6)
       (add-rat (make-rat 1 -2) (make-rat 1 3)))

(test* "(+ 1/2 -1/3)"
       '(1 . 6)
       (add-rat (make-rat 1 2) (make-rat -1 3)))

(test* "(+ 1/2 1/-3)"
       '(1 . 6)
       (add-rat (make-rat 1 2) (make-rat 1 -3)))

(test-section "sub-rat")
(test* "(- 1/2 1/3)"
       '(1 . 6)
       (sub-rat (make-rat 1 2) (make-rat 1 3)))

(test* "(- -1/2 1/3)"
       '(-5 . 6)
       (sub-rat (make-rat -1 2) (make-rat 1 3)))

(test* "(+ 1/-2 1/3)"
       '(-5 . 6)
       (sub-rat (make-rat 1 -2) (make-rat 1 3)))

(test* "(- 1/2 -1/3)"
       '(5 . 6)
       (sub-rat (make-rat 1 2) (make-rat -1 3)))

(test* "(- 1/2 1/-3)"
       '(5 . 6)
       (sub-rat (make-rat 1 2) (make-rat 1 -3)))

(test-section "mul-rat")
(test* "(* 1/2 1/3)"
       '(1 . 6)
       (mul-rat (make-rat 1 2) (make-rat 1 3)))

(test* "(* -1/2 1/3)"
       '(-1 . 6)
       (mul-rat (make-rat -1 2) (make-rat 1 3)))

(test* "(* 1/-2 1/3)"
       '(-1 . 6)
       (mul-rat (make-rat 1 -2) (make-rat 1 3)))

(test* "(* 1/2 -1/3)"
       '(-1 . 6)
       (mul-rat (make-rat 1 2) (make-rat -1 3)))

(test* "(* 1/2 1/-3)"
       '(-1 . 6)
       (mul-rat (make-rat 1 2) (make-rat 1 -3)))

(test-section "div-rat")
(test* "(/ 1/2 1/3)"
       '(3 . 2)
       (div-rat (make-rat 1 2) (make-rat 1 3)))

(test* "(/ -1/2 1/3)"
       '(-3 . 2)
       (div-rat (make-rat -1 2) (make-rat 1 3)))

(test* "(/ 1/-2 1/3)"
       '(-3 . 2)
       (div-rat (make-rat 1 -2) (make-rat 1 3)))

(test* "(/ 1/2 -1/3)"
       '(-3 . 2)
       (div-rat (make-rat 1 2) (make-rat -1 3)))

(test* "(/ 1/2 1/-3)"
       '(-3 . 2)
       (div-rat (make-rat 1 2) (make-rat 1 -3)))

(test-section "equal-rat?")
(test* "(= 1/2 1/3)"
       #f
       (equal-rat? (make-rat 1 2) (make-rat 1 3)))

(test* "(= 1/2 1/2)"
       #t
       (equal-rat? (make-rat 1 2) (make-rat 1 2)))

(test* "(= 1/2 2/4)"
       #t
       (equal-rat? (make-rat 1 2) (make-rat 2 4)))

(test-end)

gauche.test モジュール良いですね。