SICPを読む(86) 問題 2.74 データベース統合を急げ

楽しげな問題なので、ちょっと改題。

問題 2.74

ボクノス有限責任会社(Boxnos Enterprises, Inc)は世界に類を見ない弱小企業である。社長tanakaは危機感を感じていた。このままでは、OSなんかいつまで経っても作れないぞ。

「これはいかん」

そこで、社長tanakaは考えた。世界有数のハッカーを集めたSICP有限責任会社(SICP Enterprises, Inc)を買収して、OS製作を加速させるのだ〜。

大金を払って買収したのはいいが重要な問題が発生した。社員データベースの構造が異なっていて統合を計る必要に迫られた。金が無いので、データベースの再構築なんて事は出来ない。事業所ごとに異なったデータ構造を保ちながら、データベースの統合を急げ。

という問題です。データは以下のとおり。

(define boxnos-db
  '((Tanaka (0  Kashiwa))
    (Hoge   (20 Matudo ))
    (Moge   (23 Kitasenju))))

(define sicp-db
    '((Wada    Tokyo          2200)
      (Sassman Masasachusetts 2400)))

データベースは、名前のキーを持っていますが、住所、給与のデータ部が全く異なります。しかも給与は月収と年収。困っちゃうな・・・。

借金だらけなので、社長tanakaがデータベースの統合を進めていきます。トホホ。

a

本部のために、従業員ファイルから指定した従業員レコードを返すget-recodeを実装します。

(define (install-boxnos-package)
  ;; private
  (define db boxnos-db)

  ;; public
  (define (get-record name)
    (cons 'boxnos
          (assq name db)))

  (put 'get-record 'boxnos get-record))

(install-boxnos-package)

(define (install-sicp-package)
  ;; private
  (define db sicp-db)

  ;; public
  (define (get-record name)
    (cons 'sicp
          (assq name db)))

  (put 'get-record 'sicp get-record))

(install-sicp-package)

(define (get-record file name)
  ((get 'get-record file) name))

(get-record 'boxnos 'Tanaka) ; (boxnos Tanaka (0 Kashiwa))
(get-record 'sicp 'Sassman)  ; (sicp Sassman Masasachusetts 2400)

社長tanaka失敗です。

get-recordで取得したのはデータベースから取得しただけの生データ。タグだけ付けただけで、整形されてません。全然ダメです。

しかし、資金が底を付いてます!!

修正はせずそのまま突き進みます。泥沼の様相です。

b

本部の為に、従業員レコードから給与の情報を返すget-salaryを実装していきます。挽回せねば・・・。

(define (install-boxnos-package)
  ;; private
  (define db boxnos-db)

  ;; accsesser
  (define name car)
  (define address cadadr)
  (define (salary r)  (* (caadr r) 12))

  ;; public
  (define (get-record name)
    (cons 'boxnos
          (assq name db)))

  (put 'get-name    'boxnos name)
  (put 'get-address 'boxnos address)
  (put 'get-salary  'boxnos salary)
  (put 'get-record  'boxnos get-record))

(install-boxnos-package)

(define (install-sicp-package)
  ;; private
  (define db sicp-db)

  ;; accsesser
  (define name car)
  (define address cadr)
  (define salary caddr)

  ;; public
  (define (get-record name)
    (cons 'sicp
          (assq name db)))

  (put 'get-name    'sicp name)
  (put 'get-address 'sicp address)
  (put 'get-salary  'sicp salary)
  (put 'get-record  'sicp get-record))

(install-sicp-package)

;; global
(define (get-package record)
  (car record))
(define (get-data record)
  (cdr record))

(define (get-record file name)
  ((get 'get-record file) name))

(define (get-info info record)
  ((get info (get-package record)) (get-data record)))
(define (get-name record) (get-info 'get-name record))
(define (get-address record) (get-info 'get-address record))
(define (get-salary record) (get-info 'get-salary record))

;; test
(define tanaka (get-record 'boxnos 'Tanaka)) ; (boxnos Tanaka (0 Kashiwa))
(define sassman (get-record 'sicp 'Sassman)) ; (sicp Sassman Masasachusetts 2400)

(get-name tanaka)    ; Tanaka
(get-address tanaka) ; Kashiwa
(get-salary tanaka)  ; 0

(get-name sassman)    ; Sassman
(get-address sassman) ; Masasachusetts
(get-salary sassman)  ; 2400

タグを付けたのが役立ちました。データ構造はそのままでも、同じ手続きでデータを取得出来ました。一安心です。

c

全ての従業員ファイルリストから従業員レコードを取得します。

(define (find-employee-record name lis)
  (if (null? lis)
      (error "undefind name" name)
      (let ((record (get-record (car lis) name)))
        (if (cdr record)
            record
            (find-employee-record name (cdr lis))))))

(find-employee-record 'Wada '(boxnos sicp)) ; (sicp Wada Tokyo 2200)

共通アクセサを使えばデータを取得出来るので生データでもいいんです!!

急いで作ったので、get-recordの時、エラー処理を忘れてました。えへへ。

見付からないと、(sicp . #f)などという変わったデータを返すので、それにあわせて修正をかけてます。従業員検索するときは、find-employee-recordを使った方が安心です。

予算が無い中で一気に仕上げてみました。データベースが違っても同じ手続きでデータを取得することが出来るようになりました。データベースの再構築は予算が出来てから行いたいと思います。

d

もしも、ボクノス有限責任会社が順風満帆に成長し、新しい会社を買収したとき、新しい従業員情報を中央システムに組み込むには、今のデータベースと同じように構築すれば良い。現在のシステムに手を加える必要は無い。

「データベース統合を急げ」ミッション完了〜。楽しかった。