@uents blog

Code wins arguments.

SICP 読書ノート#21 - 2.4.3 データ主導プログラミングと加法性(2) (pp.108-109)

SICP Scheme

「§2.4.3 データ主導プログラミングと加法性」の続きから。

全体のソースコードはGitHubに置いています。

問題 2.74

アキナイ有限会社 (Insatiable Enterprises, Inc.) のデータベースを統合する。

演算テーブル、型タグ、apply-genericは前回のエントリのものを流用する。

a. 指定された事業所ファイルから従業員のレコードを返すget-recordを実装せよ

引数nameにタグがないのでapply-genericは使えない。

(define (get-record file name)
  (let* ((tag (type-tag file))
         (record ((get 'get-record tag) (contents file) name)))
    (if (null? record)
        nil
        (attach-tag tag record))))

b. 従業員のレコードから給与情報を返すget-salaryを実装せよ

(define (get-salary record)
  ((get 'get-salary (type-tag record)) (contents record)))

c. 全ての事業所ファイルに対し従業員のレコードを返すfind-employee-recordを実装せよ

従業員リストをget-recordでmapして、pair?でfilterすることでnilを省く

(define (find-employee-record files name)
  (filter pair? (map (lambda (file) (get-record file name)) files)))

データベースに適用する

東京オフィスのデータベースを以下のように定義する。

(define *tokyo-office-database*
'(((Hiroshi Nakajima) . 1200)
  ((Katsuo Isono) . 1500)
  ((Hanako Hanazawa) . 1400)
  ((Kaori Ohzora) . 1800)))

データベースへのアクセサパッケージを実装。

(define (install-tokyo-office-package)
  ;; internal
  (define (name-record record) (car record))
  (define (salary-record record) (cdr record))
  (define (get-record file name)
    (cond ((null? file) nil)
          ((equal? name (name-record (car file))) (car file))
          (else (get-record (cdr file) name))))
  (define (get-salary record)
    (salary-record record))

  ;; interface
  (put 'get-record 'tokyo get-record)
  (put 'get-salary 'tokyo get-salary)
  'done)

(install-tokyo-office-package)

東京オフィスのデータベースにタグを付ける。

(define *tokyo-office-file*
  (attach-tag 'tokyo *tokyo-office-database*))

テスト。

racket@> (get-salary (get-record *tokyo-office-file* '(Katsuo Isono)))
1500

racket@> (get-record *tokyo-office-file* '(Wakeme Isono))
'()

今度は、大阪オフィスのデータベースを追加する。東京オフィスとは違い、レコードの先頭にユニークIDが付与されているものとする。

(define *osaka-office-database*
'((1 (Namihei Isono) 3600)
  (2 (Masuo Fuguta) 2400)
  (3 (Nanbutsu Isasaka) 4500)))

大阪オフィスのアクセサパッケージを追加。

(define (install-osaka-office-package)
  ;; internal
  (define (id-record record) (car record))
  (define (name-record record) (cadr record))
  (define (salary-record record) (caddr record))
  (define (get-record file name)
    (cond ((null? file) nil)
          ((equal? name (name-record (car file))) (car file))
          (else (get-record (cdr file) name))))
  (define (get-salary record)
    (salary-record record))

  ;; interface
  (put 'get-record 'osaka get-record)
  (put 'get-salary 'osaka get-salary)
  'done)

(install-osaka-office-package)

データベースにタグ付け。

(define *osaka-office-file*
  (attach-tag 'osaka *osaka-office-database*))

テスト。

racket@> (get-salary (get-record *osaka-office-file* '(Masuo Fuguta)))
2400

find-employee-recordも試してみる。

racket@> (find-employee-record
          (list *tokyo-office-file* *osaka-office-file*)
          '(Katsuo Isono))
'((tokyo (Katsuo Isono) . 1500))

racket@> (find-employee-record
          (list *tokyo-office-file* *osaka-office-file*)
          '(Namihei Isono))
'((osaka 1 (Namihei Isono) 3600))

racket@> (find-employee-record
          (list *tokyo-office-file* *osaka-office-file*)
          '(Wakeme Isono))
'()

できた！

d. この企業が別の会社を合併した時に、新しい従業員情報を中央システムに組み込むには、どういう変更をすべきか

  • データベースファイルにタグ付けする
  • データベースファイルのアクセサパッケージを定義する

従来のシステムを修正することなく、単に付け加えればよいだけ。なるほど。これが加法的(additive)ということみたい。データ主導プログラミング、おもしろいな。

次回は第3の手法、メッセージパッシングを見る。

※「SICP読書ノート」の目次はこちら