Scheme - 抽象データの多重表現(二レベルのタグシステムと選択子、内部型システム、等価述語、零(汎用述語))

計算機プログラムの構造と解釈
Gerald Jay Sussman, Julie Sussman
Harold Abelson (原著) 和田 英一 (翻訳)

開発環境

• OS X Lion - Apple(OS)
• Emacs、BBEdit - Bare Bones Software, Inc. (Text Editor)
• プログラミング言語: MIT/GNU Scheme

計算機プログラムの構造と解釈(Gerald Jay Sussman(原著)、Julie Sussman(原著)、Harold Abelson(原著)、和田 英一(翻訳)、ピアソンエデュケーション、原書: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の2(データによる抽象の構築)、2.5(汎用演算のシステム)、2.5.1(汎用算術演算)の問題 2.77、問題 2.78、問題 2.79、問題 2.80を解いてみる。

その他参考書籍

• Instructor's Manual to Accompany Structure & Interpretation of Computer Programs

問題 2.77

汎用選択子、magnitudeの定義。

(define (magnitude z) (apply-generic 'magnitude z))

式(magnitude z)を評価する時。

(apply-generic 'magnitude (cons 'complex (cons 'rectangular (cons 3 4))))

(map type-tag (list (cons 'complex (cons 'rectangular (cons 3 4)))))

(get 'magnitude '(complex))

(apply magnitude (list (cons 'rectangular (cons 3 4))))

(magnitude (cons 'rectangular (cons 3 4)))

(apply-generic 'magnitude (cons 'rectangular (cons 3 4)))

(map type-tag (list (cons 'rectangular (cons 3 4))))

(get 'magnitude '(rectangular))

;; 以下のmagnitudeはrectangularパッケージの内部手続き
(apply magnitude (list (cons 3 4)))

(magnitude (cons 3 4))

;; 以下のreal-part、imag-partはrectangularパッケージの内部手続き
(sqrt (+ (square (real-part (cons 3 4)))
         (square (imag-part (cons 3 4)))))

(sqrt (+ (square 3)
         (square 4)))

(sqrt (+ 9 16))

(sqrt 25)

5

ということで、apply-genericは2回呼び出される。

問題 2.78

修正した部分。

コード

sample.scm

(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)
        (error "Bad tagged datum -- TYPE-TAG" datum)))
(define (contents datum)
  (cond ((pair? datum) (cdr datum))
        ((number? datum) datum)
        (error "Bad tagged datum -- CONTENTS" datum)))

問題 2.79、2.80

追加個所のみ。

コード

sample.scm

(define (equ? a b) (apply-generic 'equ? x y))
(define (=zero? x) (apply-generic '=zero? x))

;; install-scheme-number-package
  (define (=zero? x) (= x 0))
  (put 'equ? '(scheme-number scheme-number) =)
  (put '=zero? '(scheme-number) =zero?)

;; install-rational-package
  (define (equ? x y)
    (and (= (numer x) (numer y))
         (= (denom x) (denom y))))
  (define (=zero? x) (= (numer x) 0))
  (put 'equ? '(rational rational) equ?)
  (put '=zero? '(rational) =zero?)

;; install-complex-package
  (define (equ? z1 z2)
    (and (= (real-part z1) (real-part z2))
         (= (imag-part z1) (imag-part z2))))
  (define (=zero? z) (= (magnitude z) 0))
  (put 'equ? '(complex complex) equ?)
  (put '=zero? '(complex) =zero?)