2.4抽象データの多重表現

(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-complez z1 z2)
  (make-from-mag-ang (* (magnitude z1) (magnitude z2))
                     (+ (angle z1) (angle z2))))
(define (div-complex z1 z2)
  (make-from-mag-imag (/ (magnitude z1) (magnitude z2))
                      (- (angle z1) (angle z2))))

問題2.73

(define operation-table '())
(define (put key1 key2 value)
  (let ((t (assq key1 operation-table)))
    (if t
        (let ((u (assq key2 t)))
          (if u
              (set-cdr! u value)
              (set-cdr! t (cons (cons key2 value) (cdr t)))))
        (set! operation-table
              (list (cons key1 (list (cons key2 value))))))))
(define (get key1 key2)
  (let ((t (assq key1 operation-table)))
    (if t
        (let ((u (assq key2 t)))
          (if u
              (cdr u)
              #f))
        #f)))

(define (deriv exp var)
  (cond ((number? exp) 0)
        ((variable? exp) (if (eq? var exp) 1 0))
        (else
         ((get 'deriv (operator exp)) (operands exp) var))))
(define (variable? x) (symbol? x))
(define (operator exp) (car exp))
(define (operands exp) (cdr exp))

a.
数と記号はリストではないのでタグがない。でも、最初に式を変形してタグを付ければできるはず。

(define (install-sum-package)
  (define (addend operands) (car operands))
  (define (augend operands)
    (cond ((null? (cdr operands)) (car operands))
          (else (cons '+ (cdr operands)))))
  (define (make-sum a b)
    (list '+ a b))
  (define (deriv-sum operands var)
    (make-sum (deriv (addend operands) var)
              (deriv (augend operands) var)))
)

(define (install-product-package)
  (define (make-product a b)
    (list '* a b))
  (define (multiplier operands)
    (car operands))
  (define(multiplicant operands)
    (cond ((null? (cdr operands)) (car operands))
          (else (cons '* (cdr operands)))))
  (define (deriv-product operands var)
    (make-sum (make-product (multiplier operands)
                            (deriv (multiplicant operands) var))
              (make-product (deriv (multiplier operands) vara)

                            (multiplicant operands))))
  (put 'deriv '+ deriv-sum)
  (put 'deriv '* deriv-product)
  )
(install-deriv-package)

(define (deriv-exponentiation args var)
  (make-product (cadr args)
                (make-product (make-exponentiation (car args)
                                                   (- (cadr args) 1))
                              (deriv (car args)))))
(put 'deriv '** deriv-exponentiation)

d.
putの引数の順番を入れ替えるだけで良い。例えば、

(put 'deriv '+ deriv-sum)

は

(put '+ 'deriv deriv-sum)

になる。

問題2.74

各事業所のファイルで、レコードの集合がどのような形式であるか、レコード自体がどのような形式であるか、という型情報が必要だ。

(define operation-table '())
(define (get-pair op-name division)
  (define (loop l)
    (if (null? l)
        #f
        (let ((p (car l)))
          (let ((tags (car p))
                (op (cdr p)))
            (if (and (eq? op-name (car tags)) (eq? division (cadr tags)))
                p
                (loop (cdr l)))))))
  (loop operation-table)
  )

(define (put op division proc)
  (let ((p (get-pair op division)))
    (if p
        (set-cdr! p proc)
        (set! operation-table
              (cons (cons (list op division) proc) operation-table)))))
        
(define (get op-name division)
  (let ((p (get-pair op-name division)))
    (if p (cdr p) p)))

(define (type-tag x)
  (car x))
(define (content x)
  (cadr x))

(define (get-record file employee)
  ((get 'get-record (type-tag file)) (content file) employee))

(define (get-salary record)
  ((get 'get-item (type-tag record)) (content record) 'salary))

(define (find-employee-record employee-name division-file-list)
  (map (lambda (file)
         (get-record file employee-name))
       division-file-list))

(define (make-file division x)
  (list division x))
(define (make-record division x)
  (list division x))

(define (install-division-1)
  (define (assq2 x alist)
    (cond ((null? alist) #f)
          ((eq? x (car (content (car alist)))) (car alist))
          (else (assq2 x (cdr alist)))))
  (define (get-record file employee-name)
    (assq2 employee-name file))
  (define (get-item record item-name)
    (cdr (assq item-name record)))
  
  (put 'get-record 'division-1 get-record)
  (put 'get-item 'division-1 get-item)
  )


(define division-1-file
  (make-file 'division-1
             (list 
              (make-record 'division-1 '(Bob  (salary . 100) (age . 28)))
              (make-record 'division-1 '(Mike (salary . 120) (age . 32))))))
(install-division-1)

a.
ファイルにタグを付ける
b.
各レコードにもタグを付ける。
c.簡単。
d.
従業員ファイルに、新しいタグを設定する。putを使って、従業員ファイルを扱うのに適切な手続きを登録する。

# make-file, make-recordのgenericにした方がいいかも。

問題2.75

(define (maek-from-mag-ang mag ang)
  (define (dispatch op)
    (cond ((eq? op 'real-part) (* mag (cos ang)))
          ((eq? op 'imagp-part) (* mag (sin ang)))
          ((eq? op 'magnitude) mag)
          ((eq? op 'angle) ang)
          (else
           (error "Unknown op -- MAKE-FROM-REAL-IMAG" op))))
  disptach)

問題2.76

明確な場合分けを持つ場合
- 新しい型の追加：　既存の演算に、新たな型に対する処理を追加する。大規模な変更。
- 新しい演算の追加：　既存のすべての型に対応した演算を一つ追加する。小規模な変更。
データ主導流
- 新しい型の追加：表に新しい型とそれに対応した演算を追加。
- 新しい演算の追加：既存の型の分だけ、それぞれに対応した演算を追加する。
メッセージパッシング流
- 新しい型の追加：新しい型のディスパッチャを一つ追加。
- 新しい演算の追加：既存の型すべてのディスパッチャに、新しい演算に対する処理を追加。

新たな型が絶えず追加されるシステムでは、メッセージパッシング流もっとも変更の手間が少なくてよい。
新たな演算が絶えず追加されるシステムでは、明確な場合分けがもっとも変更の手間が少なくてよい。
しかし、両方の場合ともデータ主導流の場合は、少し手間が多いだけであり、メソッドの置き換えやそれぞれの引数の型による場合分けができるので、柔軟性が高い。