SICP 問題 2.84（型が混合しているデータ同士の演算）

Scheme SICP

問題

問題2.83のraise演算を使ってapply-generic手続きを修正し、本節で論じたように順次を決めていく方法で、引数を同じ型になるまで強制変換するようにせよ。二つの型のいずれが塔の中で高いかをテストする方法を考えなければならない。これをシステムの他の部分と「整合している」方法で行い、塔に新レベルを追加する時の問題を生じないようにせよ。

解答

まずapply-genericについて基本方針を考えてみようと思ったけど、わけがわからなくなったのでできるとこから考えてみよう。


問題文後半の「二つの型のいずれが塔の中で高いかをテストする方法」を実装してみよう。引数として型タグを二つ受け取って高い方を返却する感じ。

;より高いタグを返却する
(define (higher? tag0 tag1)
  ;塔の順序リスト
  (define tag-tower '(scheme-number rational real complex))

  ;指定したタグのインデックスを返却
  (define (index tag)
    (let ((order (member tag tag-tower)))
      (if (eq? #f order)
	  (error "No match type -- HIGHER~INDEX?" tag)
	  (- (length tag-tower) (length order)))))

  ;タグのインデックス比較
  (let ((index0 (index tag0))
	(index1 (index tag1)))
    (if (< index0 index1)
	tag1
	tag0)))

こんな感じ？新しいレベルが必要になったらtag-towerに挿入なり追加するなりすればいいわけで。
実験したいが、パターンが多いからテスト用の手続きを実装してみよう。

(define (higher?-test)
  (define (print-test-result tag0 tag1 answer)
    ;guardの第２引数部分を評価中にerrorが発生したら、
    ;guardの第１引数部分が評価される。
    (guard (exc
	    ((<error> exc)
	     (print (eq? #f answer) " : " tag0 " " tag1 " > " #f)))
      ;ここが実際に実行されるロジック部分
      (let ((result (higher? tag0 tag1)))
	      (print (eq? answer result) " : " tag0 " " tag1 " > " result))))
    
  (print "")
  (print "------------------------------")
  (print "TEST of 'higher?' procedure.")
  (print "------------------------------")
  (print-test-result 'scheme-number 'scheme-number 'scheme-number)
  (print-test-result 'scheme-number 'rational 'rational)
  (print-test-result 'scheme-number 'real 'real)
  (print-test-result 'scheme-number 'complex 'complex)
  (print-test-result 'scheme-number 'dummy #f)
  (print-test-result 'rational 'scheme-number 'rational)
  (print-test-result 'real 'scheme-number 'real)
  (print-test-result 'complex 'scheme-number 'complex)
  (print-test-result 'dummy 'scheme-number #f)

  (print-test-result 'rational 'rational 'rational)
  (print-test-result 'rational 'real 'real)
  (print-test-result 'rational 'complex 'complex)
  (print-test-result 'rational 'dummy #f)
  (print-test-result 'real 'rational 'real)
  (print-test-result 'complex 'rational 'complex)
  (print-test-result 'dummy 'rational #f)

  (print-test-result 'real 'real 'real)
  (print-test-result 'real 'complex 'complex)
  (print-test-result 'real 'dummy #f)
  (print-test-result 'complex 'real 'complex)
  (print-test-result 'dummy 'real #f)

  (print-test-result 'complex 'complex 'complex)
  (print-test-result 'complex 'dummy #f)
  (print-test-result 'dummy 'complex #f))

うむ。では実験。



gosh> (higher?-test)



    

  • 

      

    • 

        

      • 

          

        • 

            

          • 

              

            • 

                

              • 

                  

                • 

                    

                  • 

                      

                    • 

                        

                      • 

                          

                        • 

                            

                          • 

                              

                            • 

                                

                              • 

                                  

                                • 

                                    

                                  • 

                                      

                                    • 

                                        

                                      • 

                                          

                                        • 

                                            

                                          • 

                                              

                                            • 

                                                

                                              • 

                                                  

                                                • 

                                                    

                                                  • 

                                                      

                                                    • 

                                                        

                                                      • 

                                                          

                                                        • 

                                                            

                                                          • -
                                                            • 

                                                          • 

                                                        • 

                                                      • 

                                                    • 

                                                  • 

                                                • 

                                              • 

                                            • 

                                          • 

                                        • 

                                      • 

                                    • 

                                  • 

                                • 

                              • 

                            • 

                          • 

                        • 

                      • 

                    • 

                  • 

                • 

              • 

            • 

          • 

        • 

      • 

    • 

TEST of 'higher?' procedure.



    

  • 

      

    • 

        

      • 

          

        • 

            

          • 

              

            • 

                

              • 

                  

                • 

                    

                  • 

                      

                    • 

                        

                      • 

                          

                        • 

                            

                          • 

                              

                            • 

                                

                              • 

                                  

                                • 

                                    

                                  • 

                                      

                                    • 

                                        

                                      • 

                                          

                                        • 

                                            

                                          • 

                                              

                                            • 

                                                

                                              • 

                                                  

                                                • 

                                                    

                                                  • 

                                                      

                                                    • 

                                                        

                                                      • 

                                                          

                                                        • 

                                                            

                                                          • -
                                                            • 

                                                          • 

                                                        • 

                                                      • 

                                                    • 

                                                  • 

                                                • 

                                              • 

                                            • 

                                          • 

                                        • 

                                      • 

                                    • 

                                  • 

                                • 

                              • 

                            • 

                          • 

                        • 

                      • 

                    • 

                  • 

                • 

              • 

            • 

          • 

        • 

      • 

    • 

#t : scheme-number scheme-number > scheme-number

#t : scheme-number rational > rational

#t : scheme-number real > real

#t : scheme-number complex > complex

#t : scheme-number dummy > #f

#t : rational scheme-number > rational

#t : real scheme-number > real

#t : complex scheme-number > complex

#t : dummy scheme-number > #f

#t : rational rational > rational

#t : rational real > real

#t : rational complex > complex

#t : rational dummy > #f

#t : real rational > real

#t : complex rational > complex

#t : dummy rational > #f

#t : real real > real

#t : real complex > complex

#t : real dummy > #f

#t : complex real > complex

#t : dummy real > #f

#t : complex complex > complex

#t : complex dummy > #f

#t : dummy complex > #f

#

gosh>
いいねぇ。じゃ、同一型になるまで強制変換をする手続きを実装してみよう。てかどうやってapply-genericと絡めればいいのかさっぱりわからんから必要そうな手続きを書いてみるって方針でやってみてる感じ。

(define (coerce-higher-type-list args)
  ;指定したタグの型になるまで強制型変換する
  (define (coerce-to x tag)
    (let loop ((data x))
      (if (eq? (type-tag data) tag)
	  data
	  (loop (raise data)))))
  ;タグのリストと最も高位のタグを抽出
  (let* ((tags (map type-tag args))
	 (highest (fold higher? (car tags) tags)))
    ;引数データを最高位のデータ型に強制型変換させて返却。
    (map (lambda (x)
	   (coerce-to x highest))
	 args)))

これでいけるはず。では実験。



gosh> (define s 5)

s

gosh> (define ra (make-rational 1 3))

ra

gosh> ra

(rational 1 . 3)

gosh> (define re (make-real 3.1415))

re

gosh> re

(real . 3.1415)

gosh> (define co (make-complex-from-real-imag 2 7))

co

gosh> co

(complex rectangular 2 . 7)

gosh> (define data-list (list s ra re co))

data-list

gosh> data-list

(5 (rational 1 . 3) (real . 3.1415) (complex rectangular 2 . 7))

gosh> (coerce-higher-type-list data-list)

((complex rectangular 5 . 0) (complex rectangular 1/3 . 0) (complex rectangular 3.1415 . 0) (complex rectangular 2 . 7))

gosh>
いいね〜。ここまで来るとapply-genericの修正の仕方が見えてきた。

(define (apply-generic op . args)
  ;今まで通り、与えられた引数で該当する手続きを取得してみる。
  (let* ((type-tags (map type-tag args))
	 (proc (get op type-tags)))
    (if proc
	(apply proc args)
	;存在しなかった場合は、引数を最高位の型に強制変換し、変換後の引数で手続きを探す。
	(let* ((coerced-list (coerce-higher-type-list args))
	       (type-tags (map type-tag coerced-list))
	       (proc (get op type-tags)))
	  (if proc
	      ;存在すればその手続きを適用し、
	      (apply proc coerced-list)
	      ;存在しなければエラー扱い。
	      (error
	       "No method for these types -- APPLY-GENERIC"
	       (list op type-tags)))))))

よし、では実験。の前にテストを書いてみようか。

(define (add-test)
  ;テスト用データ
  (define s 5)
  (define ra (make-rational 1 3))
  (define re (make-real 3.1415))
  (define co (make-complex-from-real-imag 2 7))
  (define data-list (list s ra re co))

  ;項目のテスト
  (define (print-test proc x y answer)
    (let ((result (proc x y)))
      (print (equal? result answer) " : (" proc " " x " " y ")")
      (print "        > result=" result)
      (print "        > answer=" answer)))

  ;テスト実施
  (print "")
  (print-test add s s 10)
  (print-test add s ra '(rational 16 . 3))
  (print-test add s re '(real . 8.1415))
  (print-test add s co '(complex rectangular 7 . 7))
  (print-test add ra s '(rational 16 . 3))
  (print-test add re s '(real . 8.1415))
  (print-test add co s '(complex rectangular 7 . 7))
  (print-test add ra ra '(rational 2 . 3))
  (print-test add ra re '(real . 3.4748333333333337))
  (print-test add ra co '(complex rectangular 7/3 . 7))
  (print-test add re ra '(real . 3.4748333333333337))
  (print-test add co ra '(complex rectangular 7/3 . 7))
  (print-test add re re '(real . 6.283))
  (print-test add re co '(complex rectangular 5.141500000000001 . 7))
  (print-test add co re '(complex rectangular 5.141500000000001 . 7))
  (print-test add co co '(complex rectangular 4 . 14)))

これで何度もテストできるぜ。では改めて実験。


・・・で、実験してみたらこれが全然うまくいかねー。いや、テストのロジック自体はOKで、汎用演算システム側にバグありまくりだった。心を入れ替えて改めてcalcurate-*.scmを見直してデバッグした。で、いろんなとこに手入れすぎて、どこを変更したかがわからんなったので、関連する全てのファイルの内容を再掲載しておこう。


calcurate-system.scm
;;;==============================
;;;汎用演算定義
;;;==============================

;ハッシュテーブルをロード
(load "./sicp-hashtable.scm")

;演算パッケージで扱う基本的データ型
(load "./calcurate-scheme-number.scm")


(define (apply-generic op . args)
  ;今まで通り、与えられた引数で該当する手続きを取得してみる。
  (let* ((type-tags (map type-tag args))
	 (proc (get op type-tags)))
    (if proc
	(apply proc args)
	;存在しなかった場合は、引数を最高位の型に強制変換し、変換後の引数で手続きを探す。
	(let* ((coerced-list (coerce-higher-type-list args))
	       (type-tags (map type-tag coerced-list))
	       (proc (get op type-tags)))
	  (if proc
	      ;存在すればその手続きを適用し、
	      (apply proc coerced-list)
	      ;存在しなければエラー扱い。
	      (error
	       "No method for these types -- APPLY-GENERIC"
	       (list op type-tags)))))))

(define (coerce-higher-type-list args)
  ;指定したタグの型になるまで強制型変換する
  (define (coerce-to x tag)
    (let loop ((data x))
      (if (eq? (type-tag data) tag)
	  data
	  (loop (raise data)))))
  ;タグのリストと最も高位のタグを抽出
  (let* ((tags (map type-tag args))
	 (highest (fold higher? (car tags) tags)))
    ;引数データを最高位のデータ型に強制型変換させて返却。
    (map (lambda (x)
	   (coerce-to x highest))
	 args)))

;より高いタグを返却する
(define (higher? tag0 tag1)
  ;塔の順序リスト
  (define tag-tower '(scheme-number rational real complex))

  ;指定したタグのインデックスを返却
  (define (index tag)
    (let ((order (member tag tag-tower)))
      (if (eq? #f order)
	  (error "No match type -- HIGHER~INDEX?" tag)
	  (- (length tag-tower) (length order)))))

  ;タグのインデックス比較
  (let ((index0 (index tag0))
	(index1 (index tag1)))
    (if (< index0 index1)
	tag1
	tag0)))

(define (attach-tag type-tag contents)
  (if (eq? type-tag 'scheme-number)
      contents
      (cons type-tag contents)))

(define (type-tag datum)
  (cond ((pair? datum)
	 (car datum))
	((number? datum)
	 'scheme-number)
	(else
	 (error "Bad tagged datum -- TYPE-TAG" datum))))

(define (contents datum)
  (cond ((pair? datum)
	 (cdr datum))
	((number? datum)
	 datum)))

(define (add x y) (apply-generic 'add x y))
(define (sub x y) (apply-generic 'sub x y))
(define (mul x y) (apply-generic 'mul x y))
(define (div x y) (apply-generic 'div x y))
(define (equ? x y) (apply-generic 'equ? x y))
(define (=zero? x) (apply-generic '=zero? x))

;;１レベル高める汎用手続き
(define (raise x) (apply-generic 'raise x))
calcurate-scheme-number.scm
;;;==============================
;;;scheme-number演算パッケージ
;;;==============================


;;強制型変換を可能にする為、rationalパッケージをロードする。
(load "./calcurate-rational.scm")


(define (install-scheme-number-package)
  (define (tag x)
    (attach-tag 'scheme-number x))
  (put 'add '(scheme-number scheme-number)
       (lambda (x y) (tag (+ x y))))
  (put 'sub '(scheme-number scheme-number)
       (lambda (x y) (tag (- x y))))
  (put 'mul '(scheme-number scheme-number)
       (lambda (x y) (tag (* x y))))
  (put 'div '(scheme-number scheme-number)
       (lambda (x y) (tag (/ x y))))
  (put 'make 'scheme-number
       (lambda (x) (tag x)))
  (put 'equ? '(scheme-number scheme-number)
       (lambda (x y) (eq? x y)))
  (put '=zero? '(scheme-number)
       (lambda (x) (eq? 0 (contents x))))

  ;;;有理数への強制型変換
  (put 'raise '(scheme-number)
       (lambda (x)
	 (make-rational x 1)))

  'done)
(install-scheme-number-package)

(define (make-scheme-number n)
  ((get 'make 'scheme-number) n))
calcurate-rational.scm
;;;==============================
;;;rational演算パッケージ
;;;==============================


;;強制型変換を可能にする為、realパッケージをロードする。
(load "./calcurate-real.scm")


(define (install-rational-package)
  (define (gcd a b)
    (if (= b 0)
	a
	(gcd b (remainder a b))))
  (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))))
  (define (tag x)
    (attach-tag 'rational x))

  (put 'add '(rational rational)
       (lambda (x y) (tag (add-rat (contents x) (contents y)))))
  (put 'sub '(rational rational)
       (lambda (x y) (tag (sub-rat (contents x) (contents y)))))
  (put 'mul '(rational rational)
       (lambda (x y) (tag (mul-rat (contents x) (contents y)))))
  (put 'div '(rational rational)
       (lambda (x y) (tag (div-rat (contents x) (contents y)))))
  (put 'make 'rational
       (lambda (n d) (tag (make-rat n d))))
  (put 'equ? '(rational rational)
       (lambda (x y) (equal? x y)))
  (put '=zero? '(rational)
       (lambda (x)
	 (eq? 0 (numer x))))

  ;;;複素数への強制型変換
  (put 'raise '(rational)
       (lambda (x)
	 (make-real (/ (numer (contents x)) (denom (contents x))))))

  'done)
(install-rational-package)

(define (make-rational n d)
  ((get 'make 'rational) n d))
calcurate-real.scm
;;;==============================
;;;real演算パッケージ
;;;==============================


;;強制型変換を可能にする為、complexパッケージをロードする。
(load "./calcurate-complex.scm")


(define (install-real-package)
  (define (tag x)
    (attach-tag 'real x))
  (put 'add '(real real)
       (lambda (x y) (tag (+ (contents x) (contents y)))))
  (put 'sub '(real real)
       (lambda (x y) (tag (- (contents x) (contents y)))))
  (put 'mul '(real real)
       (lambda (x y) (tag (* (contents x) (contents y)))))
  (put 'div '(real real)
       (lambda (x y) (tag (/ (contents x) (contents y)))))
  (put 'make 'real
       (lambda (x) (tag x)))
  (put 'equ? '(real real)
       (lambda (x y) (eq? (contents x) (contents y))))
  (put '=zero? '(real)
       (lambda (x) (eq? 0 (contents x))))

  ;;;複素数への強制型変換
  (put 'raise '(real)
       (lambda (x)
	 (make-complex-from-real-imag (contents x) 0)))

  'done)
(install-real-package)

(define (make-real n)
  ((get 'make 'real) n))
calcurate-complex.scm
;;;==============================
;;;complexパッケージ
;;;==============================


;;サブパッケージに依存しているのでロード
(load "./calcurate-complex-rectanglar.scm")
(load "./calcurate-complex-polar.scm")


(define (install-complex-package)
  (define (make-from-real-imag x y)
    ((get 'make-from-real-imag 'rectangular) x y))
  (define (make-from-mag-ang r a)
    ((get 'make-from-mag-ang 'polar) r a))
  (define (add-complex z1 z2)
    (make-from-real-imag (+ (real-part z1) (real-part z2))
			 (+ (imag-part z1) (imag-part z2))))
  (define (sub-complex z1 z2)
    (make-from-real-imag (- (real-part z1) (real-part z2))
			 (- (imag-part z1) (imag-part z2))))
  (define (mul-complex z1 z2)
    (make-from-mag-ang (* (magunitude z1) (magunitude z2))
		       (+ (angle z1) (angle z2))))
  (define (div-complex z1 z2)
    (make-from-mag-ang (/ (magunitude z1) (magunitude z2))
		       (- (angle z1) (angle z2))))
  (define (real-part z)
    (apply-generic 'real-part (contents z)))
  (define (imag-part z)
    (apply-generic 'imag-part (contents z)))
  (define (magnitude z)
    (apply-generic 'magnitude (contents z)))
  (define (angle z)
    (apply-generic 'angle (contents z)))
  (define (tag z) (attach-tag 'complex z))
  
  (put 'add '(complex complex)
       (lambda (z1 z2) (tag (add-complex z1 z2))))
  (put 'sub '(complex complex)
       (lambda (z1 z2) (tag (sub-complex z1 z2))))
  (put 'mul '(complex complex)
       (lambda (z1 z2) (tag (mul-complex z1 z2))))
  (put 'div '(complex complex)
       (lambda (z1 z2) (tag (div-complex z1 z2))))
  (put 'make-from-real-imag 'complex
       (lambda (x y) (tag (make-from-real-imag x y))))
  (put 'make-from-mag-ang 'complex
       (lambda (r a) (tag (make-from-mag-ang r a))))
  (put 'real-part '(complex) real-part)
  (put 'imag-part '(complex) imag-part)
  (put 'magnitude '(complex) magnitude)
  (put 'angle '(complex) angle)
  (put 'equ? '(complex complex)
       (lambda (x y) (equal? x y)))
  (put '=zero? '(complex)
       (lambda (x)
	 (apply-generic '=zero? x)))
  'done)
(install-complex-package)

(define (make-complex-from-real-imag x y)
  ((get 'make-from-real-imag 'complex) x y))
(define (make-complex-from-mag-ang r a)
  ((get 'make-from-mag-ang 'complex) r a))

(define (real-part z) (apply-generic 'real-part z))
(define (imag-part z) (apply-generic 'imag-part z))
(define (magnitude z) (apply-generic 'magnitude z))
(define (angle z) (apply-generic 'angle z))
calcurate-complex-rectangular.scm
;;;==============================
;;;complex（rectangular）サブパッケージ
;;;==============================
(define (install-rectangular-package)
  (define (square x) (* x x))
  (define (real-part z) (car (contents z)))
  (define (imag-part z) (cdr (contents z)))
  (define (magnitude z)
    (sqrt (+ (square (real-part (contents z)))
	     (square (imag-part (contents z))))))
  (define (angle z)
    (atan (imag-part (contents z))
	  (real-part (contents z))))

  (define (make-from-real-imag x y)
    (cons x y))
  (define (make-from-mag-ang r a)
    (cons (* r (cos a)) (* r (sin a))))
  (define (tag x)
    (attach-tag 'rectangular x))

  (put 'real-part '(rectangular) real-part)
  (put 'imag-part '(rectangular) imag-part)
  (put 'magnitude '(rectangular) magnitude)
  (put 'angle '(rectangular) angle)
  (put 'make-from-real-imag 'rectangular
       (lambda (x y) (tag (make-from-real-imag x y))))
  (put 'make-from-mag-ang 'rectangular
       (lambda (r a) (tag (make-from-mag-ang r a))))
  (put 'equ? '(rectangular rectangular)
       (lambda (x y) (equal? x y)))
  (put '=zero? '(rectangular)
       (lambda (x)
	 (and (eq? 0 (real-part x))
	      (eq? 0 (imag-part x)))))
  'done)
(install-rectangular-package)
calcurate-complex-poler.scm
;;;==============================
;;;complex（polar）サブパッケージ
;;;==============================
(define (install-polar-package)
  (define (square x) (* x x))

  (define (magnitude z) (car (contents z)))
  (define (angle z) (cdr (contents z)))
  (define (real-part z)
    (* (magnitude (contents z))
       (cos (angle (contents z)))))
  (define (imag-part z)
    (* (magnitude (contents z))
       (sin (angle (contents z)))))

  (define (make-from-mag-ang r a)
    (cons r a))
  (define (make-from-real-imag x y)
    (cons (sqrt (+ (square x) (square y)))
	  (atan y x)))
  (define (tag x) (attach-tag 'polar x))

  (put 'real-part '(polar) real-part)
  (put 'imag-part '(polar) imag-part)
  (put 'magnitude '(polar) magnitude)
  (put 'angle '(polar) angle)
  (put 'make-from-real-imag 'polar
       (lambda (x y) (tag (make-from-real-imag x y))))
  (put 'make-from-mag-ang 'polar
       (lambda (r a) (tag (make-from-mag-ang r a))))
  (put 'equ? '(polar polar)
       (lambda (x y) (equal? x y)))
  (put '=zero? '(polar)
       (lambda (x)
	 (and (eq? 0 (magnitude x))
	      (eq? 0 (angle x)))))
  'done)
(install-polar-package)

さて、これらのファイル群で改めてadd-testしたした結果がこちら。



gosh> (add-test)
#t : (# 5 5)

        > result=10

        > answer=10

#t : (# 5 (rational 1 . 3))

        > result=(rational 16 . 3)

        > answer=(rational 16 . 3)

#t : (# 5 (real . 3.1415))

        > result=(real . 8.1415)

        > answer=(real . 8.1415)

#t : (# 5 (complex rectangular 2 . 7))

        > result=(complex rectangular 7 . 7)

        > answer=(complex rectangular 7 . 7)

#t : (# (rational 1 . 3) 5)

        > result=(rational 16 . 3)

        > answer=(rational 16 . 3)

#t : (# (real . 3.1415) 5)

        > result=(real . 8.1415)

        > answer=(real . 8.1415)

#t : (# (complex rectangular 2 . 7) 5)

        > result=(complex rectangular 7 . 7)

        > answer=(complex rectangular 7 . 7)

#t : (# (rational 1 . 3) (rational 1 . 3))

        > result=(rational 2 . 3)

        > answer=(rational 2 . 3)

#t : (# (rational 1 . 3) (real . 3.1415))

        > result=(real . 3.4748333333333337)

        > answer=(real . 3.4748333333333337)

#t : (# (rational 1 . 3) (complex rectangular 2 . 7))

        > result=(complex rectangular 7/3 . 7)

        > answer=(complex rectangular 7/3 . 7)

#t : (# (real . 3.1415) (rational 1 . 3))

        > result=(real . 3.4748333333333337)

        > answer=(real . 3.4748333333333337)

#t : (# (complex rectangular 2 . 7) (rational 1 . 3))

        > result=(complex rectangular 7/3 . 7)

        > answer=(complex rectangular 7/3 . 7)

#t : (# (real . 3.1415) (real . 3.1415))

        > result=(real . 6.283)

        > answer=(real . 6.283)

#t : (# (real . 3.1415) (complex rectangular 2 . 7))

        > result=(complex rectangular 5.141500000000001 . 7)

        > answer=(complex rectangular 5.141500000000001 . 7)

#t : (# (complex rectangular 2 . 7) (real . 3.1415))

        > result=(complex rectangular 5.141500000000001 . 7)

        > answer=(complex rectangular 5.141500000000001 . 7)

#t : (# (complex rectangular 2 . 7) (complex rectangular 2 . 7))

        > result=(complex rectangular 4 . 14)

        > answer=(complex rectangular 4 . 14)

#

gosh>
いいね〜。けど・・・この問題解くのに一週間以上かかってるって。。アホだなぁ俺。