関数型言語の勉強にSICPを読もう - (26) 2章 - データによる抽象の構築 (108ページ)
今日はとても長いです。
その分かなり濃い時間が過ごせたので有意義でした。
良い練習問題でした。
問題2.74 a
fileはリストとして表現する。
リストの第1要素が事業所を区別する type tag である。
type tag は company 手続きにより取得できる。
(define (get-record file name) ((get 'get-record (company file)) file name)) (define (company file) (car file))
問題2.74 b
レコードはリストとして表現する。
リストの第1要素がレコードを区別する type tag である。
type tag は record-type 手続きにより取得できる。
(define (get-salary record) ((get 'get-salary (record-type record)) record)) (define (record-type record) (car record))
問題2.74 c
与えられたファイルのリストを1つずつ見ていき従業員を探します。
(define (find-employee-record filelist name)
(if (null? filelist) #f
(let ((found (get-record (car filelist) name)))
(if found
found
(find-employee-record (cdr filelist) name)))))
問題2.74 d
file から record を得る get-record。
record から salary を得る get-salary。
を実装する。
そしてそれらを表に put すれば良い。
具体的にやってみないとこの考えが正しいか分からないのでやってみよう。
準備編 put,get
まじめに実装しないとだめですね。GaucheのHash Tableを利用します。
op-tableを手続きの中に隠蔽したいけどどうすれば良いんだろう。
(define op-table (make-hash-table))
(define (put op type item)
(if (not (hash-table-exists? op-table op))
(hash-table-put! op-table op (make-hash-table)))
(let ((type-table (hash-table-get op-table op)))
(hash-table-put! type-table type item)))
(define (get op type)
(if (not (hash-table-exists? op-table op))
(hash-table-put! op-table op (make-hash-table)))
(let ((type-table (hash-table-get op-table op)))
(hash-table-get type-table type)))
なおや事業所の実装
なおや事業所のファイル形式は
('naoya 'i 'love 'perl record1 record2 ....)のように第1要素に type tag 'naoya を持ちます。
そしてレコード自体は5番目の要素に並びます。
またレコード形式は
('naoya-record name salary)とします。
これも同様に type tagが先頭にあります。
実際のパッケージです。
(define (install-naoya-package)
;; 内部手続き
(define (name-record record)
(cadr record))
(define (salary-record record)
(caddr record))
(define (records-of-file file)
(cddr (cddr file)))
;; インターフェース
(define (get-record file name)
(define (find-record records)
(cond ((null? records) #f)
((equal? name (name-record (car records)))
(car records))
(else (find-record (cdr records)))))
(find-record (records-of-file file)))
(define (get-salary record)
(salary-record record))
;; 中略
(put 'get-record 'naoya-company get-record)
(put 'get-salary 'naoya-record get-salary)
(put 'name-record 'naoya-company name-record)
(put 'salary-record 'naoya-company salary-record)
(put 'records-of-file 'naoya-company records-of-file)
(display "installed naoya-package\n")
)
データを作り動作確認
(define (make-naoya-record name salary)
(lambda () (list 'naoya-record name salary)))
(define naoya-file (list 'naoya-company
'i
'love
'perl
((make-naoya-record 'jnaoya 1000))
((make-naoya-record 'naoya 1001))))
;; jnaoyaのsalaryは？
(display (get-salary
(find-employee-record (list naoya-file) 'jnaoya)))
1000できました！
ひげぽん事業所は?
ひげぽん事業所はファイル形式とレコードの形式がなおや事業所と違います。
こんな感じ。
(define (make-higepon-record name salary)
(lambda () (list 'higepon-record 'omaemona name salary)))
(define higepon-file (list 'higepon-company
'mona
((make-higepon-record 'jhigepon 101))
((make-higepon-record 'higepon 100))))
なのでひげぽん事業所用に get-record, get-salaryを定義してそれを put してやれば良いです。
これをまとめてやるのが install-higepon-packageです。
内部手続きが全く異なっていますね。
(define (install-higepon-package)
;; 内部手続き
(define (name-from-record record)
(caddr record))
(define (salary-from-record record)
(cadddr record))
(define (records-from-file file)
(cddr file))
;; インターフェース
(define (get-record file name)
(define (find-record records)
(cond ((null? records) #f)
((equal? name (name-from-record (car records)))
(car records))
(else (find-record (cdr records)))))
(find-record (records-from-file file)))
(define (get-salary record)
(salary-from-record record))
;; 中略
(put 'get-record 'higepon-company get-record)
(put 'get-salary 'higepon-record get-salary)
(put 'name-from-record 'higepon-company name-from-record)
(put 'salary-from-record 'higepon-company salary-from-record)
(put 'records-from-file 'higepon-company records-from-file)
(display "installed higepon-package\n")
)
ひげぽん事業所を本社に追加しましょう
なおや事業所のコードには一切変更を加える必要はありません。
必要なのは
- (install-higepon-package)を呼び出すこと
- find-employee-record手続きを呼び出すときに引数として与えるファイルリストに higepon-file を追加するだけです。
実際にやってみましょう。
;; higepon-fileを追加
(define all-company-files (list naoya-file higepon-file))
;; すべての事業所からhigeponという名前の人を探して salary を返す
(display "higepon's salary is ")
(display (get-salary
(find-employee-record all-company-files 'higepon)))
(display "\n")
;; すべての事業所からnaoyaという名前の人を探して salary を返す
(display "naoya's salary is ")
(display (get-salary
(find-employee-record all-company-files 'naoya)))結果は
higepon's salary is 100 naoya's salary is 1001
できました。
どうでしょうか。簡単に事業所を追加することができました。
はじめてフルスクラッチで Scheme のコードを書いたのでいろいろな箇所で苦労しましたがとても良い勉強になりました。
ちなみにこのコードを全部書くのに3時間くらいかかりました。
途中でTest Firstに切り替えたりと回り道しまくりｗ。
動かしてみたい方用にソースを置いておきます。何かの参考になれば幸いです。
ついでにこの書き方はまずいとかありましたらぜひつっこみをお願いします。
計算機プログラムの構造と解釈
posted with amazlet on 06.04.15
Gerald Jay Sussman Julie Sussman Harold Abelson 和田 英一
ピアソンエデュケーション (2000/02)
売り上げランキング: 56,404
ピアソンエデュケーション (2000/02)
売り上げランキング: 56,404
