SICP 問題 2.74（実際に存在しそうなシステムでデータ主導プログラミング）

問題

アキナイ有限責任会社（Insatiable Enterprises, Inc）は全世界に存在する多数の独立事業所を持つ超分散型の多国籍企業である。この会社の計算機システムは、全体のネットワークがどの利用者にも一つの計算機と見えるような、賢いネットワークインターフェース方式で相互接続された。社長はネットワークから事業所ファイルの管理情報を取り出す能力を初めて試みたとき、事業所ファイルはSchemeのデータ構造として実装してあったが、それぞれのデータ構造は、事業所毎に異なっているのを知って驚いた。事業所管理者の会合が急いで開かれ、事業所の既存の自立性を保存したまま、本部の必要性を満たすようにファイルを統合戦略を探求した。
データ主導プログラミングにより、そういう戦略を実装する方法を示せ。
例として各事業所の従業員レコードが、従業員の名前でキーをつけたレコードの集合からなる一つのファイルできているとする。集合の構造は事業所毎異なる。更に各従業員のレコード自体が（事業所毎に異なった構造の）集合で、addressとsalaryという識別子でキーをつけた情報を含んでいる。

a. 本部の為に、指定した従業員ファイルから、指定した従業員のレコードを検索する get-record 手続きを実装せよ。この手続きはどの事業所のファイルに対しても使えなければならない。それぞれの事業所ファイルはどう構造化すべきか説明せよ。得にどんな型情報が追加されるべきか。

b. 本部の為に、いずれの事業所の従業員ファイルからでも与えられた従業員のレコードから、給与の情報を返す get-salary 手続きを実装せよ。この演算が働く為には、レコードをどう構造化すべきか。

c. 本部の為に、find-employee-record 手続きを実装せよ。全ての事業所ファイルから与えられた従業員のレコードを探し、それを返すものとする。この手続きは引数として従業員の名前と全事業所ファイルのリストを取るものと仮定せよ。

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

解答

実際に実験をしていなかったのを反省して、データ主導型システムにて不可欠な get 手続きと put 手続きを実装した。
その上で、この問題からちゃんと実験をしようと思う。じゃないと理解したような気になってスルーして、結果的に血肉にならん。

さて、get と put は実装できた風なので、具体的に実験しながら考える為、一番簡単なサンプルデータを作ってしまう。

;xxx事業所ファイル
(define xxx-data '(("社員その１" "住所その１" 210000)
		   ("社員その２" "住所その２" 220000)
		   ("社員その３" "住所その３" 230000)))

さて、これをベースに考えていくわけだが、面倒なのでもうパッケージを作っていっちゃう。

(define (install-xxx-package)
  ;;Private
  ;db
  (define (make-db records)
    (attach-tag 'xxx records))
  (define (get-record db name)
    (let loop ((records (cdr db)))
      (cond ((null? records)
	     #f)
	    ((string=? name (get-name (car records)))
	     (car records))
	    (else
	     (loop (cdr records))))))
  ;record
  (define (make-record name address salary)
    (list name address salary))
  (define (get-name record)
    (car record))
  (define (get-address record)
    (cadr record))
  (define (get-salary record)
    (caddr record))

  ;;Public
  (put 'make-db 'xxx make-db)
  (put 'make-record 'xxx make-record)
  (put 'get-record 'xxx get-record)
  (put 'get-salary 'xxx get-salary)
  'done)

(install-xxx-package)

パッケージ内で定義できない手続き（DBの生成、レコードの生成手続き）を定義しとく。

(define xxx-db ((get 'make-db 'xxx) xxx-data))

(define (make-record-xxx name address salary)
  ((get 'make-record 'xxx) name address salary))

これで下準備OK。

a.

汎用手続き get-record を実装しろと。引数は db(従業員ファイル）、name（従業員の名前）。汎用手続きは当然ながらパッケージの外部に定義する。

;従業員のレコードを取得する手続き。
;　db   : 従業員ファイル
;　name : キーとなる従業員の名前
(define (get-record db name)
  ((get 'get-record (type-tag db)) db name))

では実験。

gosh> (get-record xxx-db "社員その１")

("社員その１" "住所その１" 210000)

gosh> 

ま、もう既に make-db で定義してあるけど、データの型を識別するための型タグが必要。

b

早速実装を。

(define (get-salary db name)
  (let ((target (get-record db name))
	(proc (get 'get-salary (type-tag db))))
    (if (eq? #f target)
	#f
	(proc target))))

では実験。

gosh> (get-salary xxx-db "社員その１")

210000

gosh> (get-salary xxx-db "社員その２")

220000

gosh> (get-salary xxx-db "社員その３")

230000

gosh> (get-salary xxx-db "社員その４")

#f

gosh> 

レコードの構造化については・・・xxx-data 内の全レコードでフォーマットを同じにすりゃいい。約束事の範疇だな。xxx-dataに関してはレコードをリスト構造で構築し、その上で salary については先頭から２番目の要素にしたが、別にこれは連想配列でもhashtableでも、内部の保持の仕方はどうだっていい。取り出し方がパッケージ内でちゃんと定義してありさえすれば。

c.

まずは実装。

(define (find-employee-record db-list name)
  (let loop ((dbs db-list))
    (if (null? dbs)
	#f
	(let ((target (get-record (car dbs) name)))
	  (if (eq? #f target)
	      (loop (cdr dbs))
	      target)))))

実験するためには、別の db とパッケージが必要だな。ちょちょっと作ってしまおう。

;yyy事業所データ
(define yyy-data '((1 ("yyy社員その１" "yyy住所その１" 310000))
		   (2 ("yyy社員その２" "yyy住所その２" 320000))
		   (3 ("yyy社員その３" "yyy住所その３" 330000))))

(define (install-yyy-package)
  ;;Private
  ;db
  (define (make-db records)
    (attach-tag 'yyy records))
  (define (get-record db name)
    (let loop ((records (cdr db)))
      (cond ((null? records)
	     #f)
	    ((string=? name (get-name (car records)))
	     (car records))
	    (else
	     (loop (cdr records))))))
  ;record
  (define (make-record name address salary)
    (list -1 (list name address salary)))
  (define (get-contents record) ;ここが xxx パッケージと違う感じ。
    (cadr record))
  (define (get-name record)
    (car (get-contents record)))   ;get-contents 使う
  (define (get-address record)
    (cadr (get-contents record)))  ;get-contents 使う
  (define (get-salary record)
    (caddr (get-contents record))) ;get-contents 使う

  ;;Public
  (put 'make-db 'yyy make-db)
  (put 'make-record 'yyy make-record)
  (put 'get-record 'yyy get-record)
  (put 'get-salary 'yyy get-salary)
  'done)

(install-yyy-package)

(define yyy-db ((get 'make-db 'yyy) yyy-data))

(define (make-record-yyy name address salary)
  ((get 'make-record 'yyy) name address salary))

では実験。

gosh> (find-employee-record (list xxx-db yyy-db) "社員その２")

("社員その２" "住所その２" 220000)

gosh> (find-employee-record (list xxx-db yyy-db) "yyy社員その２")

(2 ("yyy社員その２" "yyy住所その２" 320000))

gosh> 

いいね〜！

d.

この企業が別の会社を合併した時、新しい従業員情報を中央システムに組み込むにはどういう変更をすべきか。
c でやったように、型タグ付きのデータの生成と、それを操作するための専用パッケージを追加すりゃいい。

ど〜だこのやろう、前よりもう少しだけ理解できたぞ〜。