SICP 読み (50) 2.4.2 タグつきデータ

昨晩は微妙な会合に出席してきたのですが、開始時間まで間があったので食事を取りつつサケを呑みつつ SICP の 2.4.3 以降の部分を読みながら暇をツブしてまして、SICP にもサケを呑ませてしまった (こぼした、とも言う)。カワいた後に匂いをカイでみると若干サケ臭い。
試験を書いた。magunitude-* とか angle-* の修正を見落していた。

で、試験は以下。なんか機械的にヤッツケちゃってる感が満点だし。

#!/usr/bin/env gosh

(use math.const)
(use test.unit)
(require "2.4.2")

(define (marume x)
  (define d 0.00001)
  (define m 100000)
  (* d (round (* m x))))

(define-test-suite "2.4.2"

("real-part test"
 ("real-part make-from-mag-ang-rectangular test"
  (let ((z (make-from-mag-ang-rectangular 2 (/ pi 6))))
    (assert-equal 1.73205
		  (marume (real-part z))))
  )
 ("real-part make-from-real-imag-rectangular test"
  (let ((z (make-from-real-imag-rectangular (sqrt 3) 1.0)))
    (assert-equal 1.73205
		  (marume (real-part z))))
 )
 ("real-part make-from-mag-ang-polar test"
  (let ((z (make-from-mag-ang-polar 2 (/ pi 6))))
    (assert-equal 1.73205
		  (marume (real-part z))))
  )
 ("real-part make-from-real-imag-polar test"
  (let ((z (make-from-real-imag-polar (sqrt 3) 1.0)))
    (assert-equal 1.73205
		  (marume (real-part z))))
 )
)

("imag-part test"
 ("imag-part make-from-mag-ang-rectangular test"
  (let ((z (make-from-mag-ang-rectangular 2 (/ pi 6))))
    (assert-equal 1.0
		  (round (imag-part z))))
  )
 ("imag-part make-from-real-imag-rectangular test"
  (let ((z (make-from-real-imag-rectangular (sqrt 3) 1.0)))
    (assert-equal 1.0
		  (round (imag-part z))))
  )
 ("imag-part make-from-mag-ang-polar test"
  (let ((z (make-from-mag-ang-polar 2 (/ pi 6))))
    (assert-equal 1.0
		  (round (imag-part z))))
  )
 ("imag-part make-from-real-imag-polar test"
  (let ((z (make-from-real-imag-polar (sqrt 3) 1.0)))
    (assert-equal 1.0
		  (round (imag-part z))))
  )
)

("magnitude test"
 ("magnitude make-from-mag-ang-rectangular test"
  (let ((z (make-from-mag-ang-rectangular 2.0 (/ pi 6))))
    (assert-equal 2.0
		  (magnitude z)))
  )
 ("magnitude make-from-real-imag-rectangular test"
  (let ((z (make-from-real-imag-rectangular (sqrt 3) 1.0)))
    (assert-equal 2.0
		  (magnitude z)))
  )
 ("magnitude make-from-mag-ang-polar test"
  (let ((z (make-from-mag-ang-polar 2.0 (/ pi 6))))
    (assert-equal 2.0
		  (magnitude z)))
  )
 ("magnitude make-from-real-imag-polar test"
  (let ((z (make-from-real-imag-polar (sqrt 3) 1.0)))
    (assert-equal 2.0
		  (magnitude z)))
  )
)

("angle test"
 ("angle make-from-mag-ang-rectangular test"
  (let ((z (make-from-mag-ang-rectangular 2 (/ pi 6))))
    (assert-equal (marume (/ pi 6))
		  (marume (angle z))))
  )
 ("angle make-from-real-imag-rectangular test"
  (let ((z (make-from-real-imag-rectangular (sqrt 3) 1.0)))
   (assert-equal (marume (/ pi 6))
		 (marume (angle z))))
  )
 ("angle make-from-mag-ang-polar test"
  (let ((z (make-from-mag-ang-polar 2 (/ pi 6))))
    (assert-equal (marume (/ pi 6))
		  (marume (angle z))))
  )
 ("angle make-from-real-imag-polar test"
  (let ((z (make-from-real-imag-polar (sqrt 3) 1.0)))
   (assert-equal (marume (/ pi 6))
		 (marume (angle z))))
  )
)

("make-from-real-imag test"
 ("make-from-real-imag-rectangular test"
  (let ((z (make-from-real-imag-rectangular (sqrt 3) 1.0)))
    (assert-equal 2.0 (magnitude z))
    (assert-equal (marume (/ pi 6)) (marume (angle z)))
    (assert-equal 1.0 (round (imag-part z)))
    (assert-equal 1.73205
		  (marume (real-part z))))
  )
 ("make-from-real-imag-polar test"
  (let ((z (make-from-real-imag-polar (sqrt 3) 1.0)))
    (assert-equal 2.0 (magnitude z))
    (assert-equal (marume (/ pi 6)) (marume (angle z)))
    (assert-equal 1.0 (round (imag-part z)))
    (assert-equal 1.73205
		  (marume (real-part z))))
  )
)

("make-from-mag-ang test"
 ("make-from-mag-ang-rectangular test"
  (let ((z (make-from-mag-ang-rectangular 2.0 (/ pi 6))))
    (assert-equal 2.0 (magnitude z))
    (assert-equal (marume (/ pi 6)) (marume (angle z)))
    (assert-equal 1.0 (round (imag-part z)))
    (assert-equal 1.73205
		  (marume (real-part z))))
  )
 ("make-from-mag-ang-polar test"
 (let ((z (make-from-mag-ang-polar 2.0 (/ pi 6))))
   (assert-equal 2.0 (magnitude z))
   (assert-equal (marume (/ pi 6)) (marume (angle z)))
   (assert-equal 1.0 (round (imag-part z)))
   (assert-equal 1.73205
		 (marume (real-part z))))
 )
)

("add-complex test"
 ("add-complex test (1) r-r"
  (let ((z1 (make-from-real-imag-rectangular 4.0 4.0))
	(z2 (make-from-real-imag-rectangular 2.0 2.0)))
    (let ((result (add-complex z1 z2)))
      (assert-equal (marume (sqrt 72)) 
		    (marume (magnitude result)))
      (assert-equal (marume (/ pi 4))
		    (marume (angle result)))
      (assert-equal (marume 6.0) 
		    (marume (imag-part result)))
      (assert-equal (marume 6.0) 
		    (marume (real-part result)))))
  )
 ("add-complex test (2) p-p"
  (let ((z1 (make-from-real-imag-polar 4.0 4.0))
	(z2 (make-from-real-imag-polar 2.0 2.0)))
    (let ((result (add-complex z1 z2)))
      (assert-equal (marume (sqrt 72)) 
		    (marume (magnitude result)))
      (assert-equal (marume (/ pi 4))
		    (marume (angle result)))
      (assert-equal (marume 6.0) 
		    (marume (imag-part result)))
      (assert-equal (marume 6.0) 
		    (marume (real-part result)))))
  )
 ("add-complex test (3) r-p"
  (let ((z1 (make-from-real-imag-rectangular 4.0 4.0))
	(z2 (make-from-real-imag-polar 2.0 2.0)))
    (let ((result (add-complex z1 z2)))
      (assert-equal (marume (sqrt 72)) 
		    (marume (magnitude result)))
      (assert-equal (marume (/ pi 4))
		    (marume (angle result)))
      (assert-equal (marume 6.0) 
		    (marume (imag-part result)))
      (assert-equal (marume 6.0) 
		    (marume (real-part result)))))
  )
)

("sub-complex test"
 ("sub-complex test (1) r-r"
  (let ((z1 (make-from-real-imag-rectangular 4.0 4.0))
	(z2 (make-from-real-imag-rectangular 2.0 2.0)))
    (let ((result (sub-complex z1 z2)))
      (assert-equal (marume (sqrt 8))
		    (marume (magnitude result)))
      (assert-equal (marume (/ pi 4))
		    (marume (angle result)))
      (assert-equal (marume 2.0)
		    (marume (imag-part result)))
      (assert-equal (marume 2.0)
		    (marume (real-part result)))))
  )
 ("sub-complex test (2) p-p"
  (let ((z1 (make-from-real-imag-polar 4.0 4.0))
	(z2 (make-from-real-imag-polar 2.0 2.0)))
    (let ((result (sub-complex z1 z2)))
      (assert-equal (marume (sqrt 8))
		    (marume (magnitude result)))
      (assert-equal (marume (/ pi 4))
		    (marume (angle result)))
      (assert-equal (marume 2.0)
		    (marume (imag-part result)))
      (assert-equal (marume 2.0)
		    (marume (real-part result)))))
  )
 ("sub-complex test (3) r-p"
  (let ((z1 (make-from-real-imag-rectangular 4.0 4.0))
	(z2 (make-from-real-imag-polar 2.0 2.0)))
    (let ((result (sub-complex z1 z2)))
      (assert-equal (marume (sqrt 8))
		    (marume (magnitude result)))
      (assert-equal (marume (/ pi 4))
		    (marume (angle result)))
      (assert-equal (marume 2.0)
		    (marume (imag-part result)))
      (assert-equal (marume 2.0)
		    (marume (real-part result)))))
  )
)

("mul-complex test"
 ("mul-complex test (1) r-r"
  (let ((z1 (make-from-real-imag-rectangular 4.0 4.0))
	(z2 (make-from-real-imag-rectangular 2.0 2.0)))
    (let ((result (mul-complex z1 z2)))
      (assert-equal (marume 16)
		    (marume (magnitude result)))
      (assert-equal (marume (/ pi 2))
		    (marume (angle result)))
      (assert-equal (marume 16)
		    (marume (imag-part result)))
      (assert-equal 0.0
		    (marume (real-part result)))))
  )
 ("mul-complex test (2) p-p"
  (let ((z1 (make-from-real-imag-polar 4.0 4.0))
	(z2 (make-from-real-imag-polar 2.0 2.0)))
    (let ((result (mul-complex z1 z2)))
      (assert-equal (marume 16)
		    (marume (magnitude result)))
      (assert-equal (marume (/ pi 2))
		    (marume (angle result)))
      (assert-equal (marume 16)
		    (marume (imag-part result)))
      (assert-equal 0.0
		    (marume (real-part result)))))
  )
 ("mul-complex test (3) r-p"
  (let ((z1 (make-from-real-imag-rectangular 4.0 4.0))
	(z2 (make-from-real-imag-polar 2.0 2.0)))
    (let ((result (mul-complex z1 z2)))
      (assert-equal (marume 16)
		    (marume (magnitude result)))
      (assert-equal (marume (/ pi 2))
		    (marume (angle result)))
      (assert-equal (marume 16)
		    (marume (imag-part result)))
      (assert-equal 0.0
		    (marume (real-part result)))))
  )
)

("div-complex test"
 ("div-complex test (1) r-r"
  (let ((z1 (make-from-real-imag-rectangular 4.0 4.0))
	(z2 (make-from-real-imag-rectangular 2.0 2.0)))
    (let ((result (div-complex z1 z2)))
      (assert-equal 2.0
		    (marume (magnitude result)))
      (assert-equal 0.0
		    (marume (angle result)))
      (assert-equal 0.0
		    (marume (imag-part result)))
      (assert-equal 2.0
		    (marume (real-part result)))))
  )
 ("div-complex test (2) p-p"
  (let ((z1 (make-from-real-imag-polar 4.0 4.0))
	(z2 (make-from-real-imag-polar 2.0 2.0)))
    (let ((result (div-complex z1 z2)))
      (assert-equal 2.0
		    (marume (magnitude result)))
      (assert-equal 0.0
		    (marume (angle result)))
      (assert-equal 0.0
		    (marume (imag-part result)))
      (assert-equal 2.0
		    (marume (real-part result)))))
  )
 ("div-complex test (3) r-p"
  (let ((z1 (make-from-real-imag-rectangular 4.0 4.0))
	(z2 (make-from-real-imag-polar 2.0 2.0)))
    (let ((result (div-complex z1 z2)))
      (assert-equal 2.0
		    (marume (magnitude result)))
      (assert-equal 0.0
		    (marume (angle result)))
      (assert-equal 0.0
		    (marume (imag-part result)))
      (assert-equal 2.0
		    (marume (real-part result)))))
  )
)
)

次の節以降は若干微妙。おもしろくはあるのですが ...