## Time-stamp: <2011-12-16 Fri 14:49:08 JST>
- 3.1 CDとレコード
- 3.2 CDのリファイリング
- 3.3 データベースの中身を見てみる
- 3.4 ユーザインタラクションを改善する
- 3.5 データベースの保存と読み出し
- 3.6 データベースにクエリを投げる
- 3.7 既存のレコードを更新する（もう1つのwhereの使い道）
- 3.8 ムダを排除して勝利を収める
CDとレコード
CDのタイトル、アーティスト名、レート、リッピング済みかなどの情報をレコードに持たせる。
ここではリストを使ったデータ構造で。
属性リスト(Property list: plist)を使う。
要素を説明するシンボルとその要素が、先頭から順に交互に並んでいるリスト。
CL-USER> (list :a 1 :b 2 :c 3)
(:A 1 :B 2 :C 3)
属性リストはgetf関数が使える。
getf関数は、属性リストとシンボルを1つずつ取り、
属性リストの中のシンボルの次にある値を返す。
ハッシュっぽいやつ。
CL-USER> (getf (list :a 1 :b 2 :c 3) :a)
1
4つのフィールドを引数にとってCDを表す属性リストを返す関数make-cd
(defun make-cd (title artist rating ripped)
(list :title title
:artist artist
:rating rating
:ripped ripped))
CL-USER> (make-cd "Roses" "Kathy Mattea" 7 t)
(:TITLE "Roses" :ARTIST "Kathy Mattea" :RATING 7 :RIPPED T)
CDのファイリング
複数のレコードを保持する。
グローバル変数*db*を使う。
グローバル変数の前後にアスタリスクをつけるのはLisp界隈のならわし。
(defvar *db* nil)
「*db*」に要素を加えるにはpushマクロが使える。
抽象化のためにadd-record関数を追加。
CL-USER> (add-record (make-cd "Roses" "Kathy Mattea" 7 t))
((:TITLE "Roses" :ARTIST "Kathy Mattea" :RATING 7 :RIPPED T))
CL-USER> (add-record (make-cd "Fly" "Dixie Chicks" 8 t))
((:TITLE "Fly" :ARTIST "Dixie Chicks" :RATING 8 :RIPPED T)
(:TITLE "Roses" :ARTIST "Kathy Mattea" :RATING 7 :RIPPED T))
pushは変更した変数の更新後の値を返す。
データベースの中身を見てみる
「*db*」を見やすくする。
データベースの内容をダンプする関数dump-db。
(defun dump-db ()
(dolist (cd *db*)
(format t "~{~a:~10t~a~%~}~%" cd)))
format関数についてはどっかでまとめる。
ユーザインタラクションを改善する
add-recordでもレコードの追加はできるけど、普通のユーザにはLispくさすぎる。
また大量に登録するには向いていない。
情報の入力を促して結果を読み込む手段がいる。
(defun prompt-read (prompt)
(format *query-io* "~a " prompt)
(force-output *query-io*)
(read-line *query-io*))
ストリーム*query-io*にpromptをフォーマットして出力。
force-outputで改行コードを待つことなくプロンプトが印字されるように保証。
テキストを1行読み込む関数read-lineで、
端末に接続された入力ストリーム*query-io*を読み込んで、
read-lineは改行文字を含まない*query-io*(文字列)を返す。
値を次々に入力してCDレコードを作るには、make-cdとprompt-readを組み合わせる
(defun prompt-for-cd ()
(make-cd
(prompt-read "Title")
(prompt-read "Artist")
(prompt-read "Rating")
(prompt-read "Ripped [y/n]: ")))
prompt-readが返すのは文字列だから、文字列以外を返してほしい部分を書き換える。
parse-integer関数でRatingを数にする。
(parse-integer (prompt-read "Rating"))
parse-integerはデフォルトでは、文字列に数以外が入っていたらエラーになるからオプションをつける。
オプション:junk-allowedを使ってエラーにならないようにする。
エラーの代わりにnilが返ってくるが、0が返ってくるように変更する。
(or (parse-integer (prompt-read "Rating") :junk-allowed t) 0)
Rippedの部分は、y/nのブール値を入れるようにする。
(y-or-n-p "Ripped [y/n]: ")
yかnを入れないと再入力を要求する。
大量にデータを入力するためにループさせる。
loopマクロを使う。
loopマクロはreturnが呼び出されるまで繰り返し実行するもの。
(defun add-cds ()
(loop (add-record (prompt-for-cd))
(if (not (y-or-n-p "Another? [y/n]: ")) (return))))
データベースの保存と読み出し
保存
登録したデータベースのレコードを保存する関数save-db。
ファイル名を引数に取り、現在のデータベースの状態を保存する。
(defun save-db (filename)
(with-open-file (out filename
:direction :output
:if-exists :supersede)
(with-standard-io-syntax
(print *db* out))))
with-open-fileマクロはfilenameに対応するファイルをオープンし、
それに対応するストリームを変数outに束縛し、
一連の式の評価が終わったらファイルをクローズする。
途中でよくないことが起きてもクローズしてくれる。
「:direction :output」で書き込みモード、
「:if-exists :supersede」で同じ名前のファイルが存在したら上書きすることを指定。
ファイルを開いたら(print *db* out)で印字。
printはLispオブジェクトを再度読み取り可能な形で出力。
with-standard-io-syntaxマクロは、標準化した出力にしてくれる。(処理系の違いを気にしなくてよくなる)
読み出し
データベースを読み戻すための関数load-db。
(defun load-db (filename)
(with-open-file (in filename)
(with-standard-io-syntax
(setf *db* (read in)))))
with-open-fileマクロの:directionはデフォルトで:inputなっている。
印字する代わりにread関数でストリームinから読み込む。
db*が上書きされるのに注意。
データベースにクエリを投げる
データベースに追加したり読みだしたりする機能はつけたけど、
いちいち全部のデータベースを読み込まないといけないから、
こんな機能があったらいい。
(select :artist "Dixie Chicks")
これでアーティスト名がDixie Chicksになっているレコードのリストを取得する。
remove-if-not関数
CL-USER> (remove-if-not #'evenp '(1 2 3 4 5 6 7 8 9 10))
(2 4 6 8 10)
述語とリストを引数にとって、元のリストから述語が真となる要素だけを含むリストを返す。
述語でなく、ラムダ式を渡すこともできる。
evenpという関数が無かったらなかったら、
CL-USER> (remove-if-not #'(lambda (x) (= 0 (mod x 2))) '(1 2 3 4 5 6 7 8 9 10))
(2 4 6 8 1)
アーティスト名にマッチするレコードを取り出す。
入力したアーティスト名にマッチしたら真を返す関数がいる。
レコードを表現するのに属性リストを使っているから、
getf関数が使える。
データベース内のある1つのレコードを保持する変数をcdとする。
cdの:artistに対応する要素を(getf cd :artist)で取る。
equal式でラムダ式で引数のartistと、cdの:artistに対応する要素が等しいか見る。
(defun select-by-artist (artist)
(remove-if-not
#'(lambda (cd) (equal artist (getf cd :artist)))
*db*))
アーティスト名での検索以外にもtitleとか，ratingとかでの検索が欲しくなる。
これらはラムダ式以外は同一の関数になるだろうから，
関数selectを使って一般化する。
(defun select (selector-fn)
(remove-if-not selector-fn *db*))
remove-if-notに変数selector-fnに束縛されたラムダ式を渡すから「#'」はいらない。
select関数を呼び出すときに「#'」が必要。
関数selectに渡すラムダ式をラッピングする。
(defun artist-selector (artist)
#'(lambda (cd) (equal (getf cd :artist) artist)))
関数artist-selectorはある関数を返す。
帰ってくる関数が参照してる変数は，関数artist-selectorが返った時点では
存在していないように見えるかもしれないが，ちゃんと動く。
このような関数を閉包(クロージャ)と呼ぶ。
「"Dixie Chicks"」を引数にしてartist-selectorを呼び出せば，
CDの:artistがDixie Chicksと同じかどうかを調べるラムダ式が得られる。
CL-USER> (select (artist-selector "Dixie Chicks"))
((:TITLE "Fly" :ARTIST "Dixie Chicks" :RATING 8 :RIPPED T)
(:TITLE "Home" :ARTIST "Dixie Chicks" :RATING 9 :RIPPED T))
他のフィールドについてもセレクタを生成する関数が必要。
似たようなセレクタ関数生成器を何度も書くのは避けたいから，汎用のセレクタ関数生成器を書く。
与えられた引数に応じて各フィールドに対応したセレクタ関数を生成したり，
フィールドの組み合わせに対応したセレクタ関数を生成する関数をつくる。
そのためにキーワードパラメータという機能について学ぶ。
引数の数を固定せずに呼び出せる関数を作れる。
普通の関数
CL-USER> (defun foo (a b c) (list a b c))
FOO
CL-USER> (foo 1 2 3)
(1 2 3)
キーワードパラメータを使った関数
CL-USER> (defun foo (&key a b c) (list a b c))
FOO
CL-USER> (foo :c 3 :a 1 :b 2)
(1 2 3)
CL-USER> (foo :a 1 :c 3)
(1 NIL 3)
CL-USER> (foo)
(NIL NIL NIL)
変数a, b, cの値は対応するキーワードに続く値に束縛される。
デフォルト値はデフォルトではnilだが，これではnilをパラメータに渡したのと区別がつかない。
これを区別するためにsupplied-pパラメータを使う。
(defun foo (&key a (b 20) (c 30 c-p)) (list a b c c-p))
上記ではbのデフォルト値は20，cのデフォルト値は30で，変数c-pがsupplied-pパラメータである。
cに値が渡されたら真，値が渡されなければ偽となる。
CL-USER> (foo :c 3 :a 1 :b 2)
(1 2 3 T)
CL-USER> (foo :a 1 :c 3)
(1 20 3 T)
CL-USER> (foo)
(NIL 20 30 NIL)
汎用セレクタ関数生成器
whereという名前で作る。
CDレコードの各フィールドに対応する4つのキーワードパラメータをとり，
whereが呼び出されたときに指定された全ての値と一致するCDを選び出すセレクタ関数を作り出す。
(defun where (&key title artist rating (ripped nil ripped-p))
#'(lambda (cd)
(and
(if title (equal (getf cd :title) title) t)
(if artist (equal (getf cd :artist) artist) t)
(if rating (equal (getf cd :rating) rating) t)
(if ripped-p (equal (getf cd :ripped) ripped) t))))
この関数はCDレコードのフィールドごとに定義された条件式のANDを返す無名関数を値として返す。
それぞれの条件式は，引数にnil以外の値が渡されていたら，
その引数がCDレコードのフィールド値と一致するかどうかを値とし，
そうでなければ真を返す。
対応するパラメータが渡されなければ，条件式は真となるから，
生成されるセレクタ関数はwhereに与えられたすべての引数と一致するCDだけを選び出せる。
フィールドrippedについては，「rippedの値がnilのCDを選べ」なのか，
「rippedの値は考慮しない」という意味でrippedの値を指定していないのかを区別できるようにしている。
動作例
CL-USER> (select (where :rating 8 :ripped t))
((:TITLE "Fly" :ARTIST "Dixie Chicks" :RATING 8 :RIPPED T))
CL-USER> (select (where :artist "Dixie Chicks"))
((:TITLE "Fly" :ARTIST "Dixie Chicks" :RATING 8 :RIPPED T)
(:TITLE "Home" :ARTIST "Dixie Chicks" :RATING 9 :RIPPED T))
既存のレコードを更新する(もう一つのwhereの使い道)
データベースであれば備えられている機能，レコードの更新機能を実現する。
SQLではwhere句に一致するレコードをまとめて更新するためにupdate文がある。
update文は更新したいレコードを選択するセレクタ関数と，
変更したい値をキーワード引数を使ってにして指定すればいい。
mapcar関数を使う。
mapcar関数は，あるリストに含まれる全ての要素について関数を適用した結果を集めた新しいリストを返す。
#+BEGIN_SRC common-lisp
(defun update (selector-fn &key title artist rating (ripped nil ripped-p))
(setf *db*
(mapcar
#'(lambda (row)
(when (funcall selector-fn row)
(if title (setf (getf row :title) title))
(if artist (setf (getf row :artist) artist))
(if rating (setf (getf row :rating) rating))
(if ripped-p (setf (getf row :ripped) ripped)))
row) *db*)))
#+END_SRC
setfは変数にだけじゃなく，「場所」に代入するのにも使えるものだと解釈しておく。
update関数でDixie Chicksのすべてのアルバムのレートを11に変える例を示す。
#+BEGIN_EXAMPLE
CL-USER> (update (where :artist "Dixie Chicks") :rating 11)
#+END_EXAMPLE
データベースからレコードを削除するための関数は簡単に作れる。
#+BEGIN_SRC common-lisp
(defun delete-row (selector-fn)
(setf *db* (remove-if selector-fn *db*)))
#+END_SRC
remove-if関数はremove-if-not関数の反対。
引数にとったリストから，条件式にマッチした要素を全て削除したリストを返す。
元のリストに変更を加えるわけではないため，setfで*db*に戻り値を保存している。
ムダを排除して勝利を収める
マクロを使って，これまで作った関数の無駄な重複を取り除く。
無駄はwhere関数にある。
各フィールドごとに
#+BEGIN_SRC
(if title (equal (getf cd :title) title) t)
#+END_SRC
のような式を評価している。
title以外のフィールドの値のチェックのときも，いちいちtitleが入っているかチェックしている。
必要以上のチェックをしている。
無駄を省くとしたら，
#+BEGIN_SRC
CL-USER> (select (where :title "Give Us a Break" :ripped t))
#+END_SRC
は以下のように変更できる。
#+BEGIN_SRC
CL-USER> (select #'(lambda (cd)
(and (equal (getf cd :title) "Give Us a Break")
(equal (getf cd :ripped) t))))
#+END_SRC
このラムダ式はwhereが返すものとは違うものを返す。
効率のいいセレクタ関数を返すように意図している。
これをマクロを使って書く。
マクロ
マクロは式を作る式。
マクロで作られた式をREPLが評価することで結果が返る。
簡単な例をやる。
reverse関数は引数に1つのリストをとり，そのリストの順序を反転したリストを返す関数。
backwardsというマクロを定義する。
マクロの定義は，defmacroに続けて名前，パラメータリスト，本体の式からなる。
#+BEGIN_SRC
CL-USER> (defmacro backwards (expr) (reverse expr))
BACKWARDS
CL-USER> (backwards ("hello, world" t format))
hello, world
NIL
#+END_SRC
動作を説明する。
- REPLがbackwardsがマクロの名前であることを認識する。
- 式("hello, world" t format)は評価されずに放っておかれる。
- backwordsの中でリストはreverseに渡され (format t "hello, world") というリストがREPLに返される。
- REPLが (format t "hello, world") を評価する。
マクロの動作おいて動作効率はまったく同じになる。
マクロを使ってwhereを改良する
もともとのwhereには各フィールドに対して以下の式があった。
#+BEGIN_SRC
(equal (getf cd field) value)
#+END_SRC
フィールドと値を受け取り上記の式を返す関数を書いてみる。
式は単なるリストだから以下のようにできると思うかもしれない。
#+BEGIN_SRC
;; 間違い
(defun make-comparison-expr (field value)
(list equal (list getf cd field) value))
#+END_SRC
これでは，equal, getf, cd, field, valueが評価される。
fieldとvalueは期待した動作であるが，equal, getf, cdは違う。
しかし，Lispはシングルクォート「'」を評価させたくないものの前につけることで，
評価をやめさせることができる。
以下のように書けば，期待した動作をする。
#+BEGIN_SRC
(defun make-comparison-expr (field value)
(list 'equal (list 'getf 'cd field) value))
#+END_SRC
#+BEGIN_EXAMPLE
CL-USER> (make-comparison-expr :rating 10)
(EQUAL (GETF CD :RATING) 10)
CL-USER> (make-comparison-expr :title "Give Us a Break")
(EQUAL (GETF CD :TITLE) "Give Us a Break")
#+END_EXAMPLE
さらにいい方法
「大半は評価されたくないけど，その中から特に評価させたい式だけを選び出して評価させることができる」ような式を書く。
バッククォート「`」を式の前に置くと，その式は評価されなくなる。
バッククォートが置かれた式の中で評価させたいものには，コンマ「,」を置く。
#+BEGIN_EXAMPLE
CL-USER> `(+ 1 2 3)
(+ 1 2 3)
CL-USER> `(+ 1 2 (+ 1 2))
(+ 1 2 (+ 1 2))
CL-USER> `(+ 1 2 ,(+ 1 2))
(+ 1 2 3)
#+END_EXAMPLE
これを使って関数make-comparison-exprを書き換える
#+BEGIN_SRC
(defun make-comparison-expr (field value)
`(equal (getf cd ,field) ,value))
#+END_SRC
セレクタ関数はフィールドと値のペア1個につき比較を行う式が1つあり，それらがandで包まれている。
whereマクロに渡す引数は単一のリストとして用意することにして，
それぞれのペアに対してmake-comparison-exprを呼び出した結果を集める関数を作る。
loopを使う。
#+BEGIN_SRC
(defun make-comparisons-list (fields)
(loop while fields
collecting (make-comparison-expr (pop fields) (pop fields))))
#+END_SRC
「while fields」はfieldsに要素が残っている間はループするという意味。
1回のループで2回のpopによりfieldsから2つの要素を取り出し，
それらにmake-comparison-exprを適用する。
その結果を集めて(collecting)，ループが終わったときの結果として返す。
最後にmake-comparisons-listから返されるリストをANDで包んでラムダ式に入れ込めばいい。
#+BEGIN_SRC
(defmacro where (&rest clauses)
`#'(lambda (cd) (and ,@(make-comparisons-list clauses))))
#+END_SRC
「,@」は,@以降の式と,@を囲んでいる式を結合する。
#+BEGIN_EXAMPLE
CL-USER> `(and ,(list 1 2 3))
(AND (1 2 3))
CL-USER> `(and ,@(list 1 2 3))
(AND 1 2 3)
CL-USER> `(and ,@(list 1 2 3) 4)
(AND 1 2 3 4)
#+END_EXAMPLE
「&rest」が引数リストにあると，関数やマクロは任意個の引数を取ることができ，
引数が1つのリストにまとめられたものが&restの後の名前の変数の値になる。（ここではclauses）
whereを
#+BEGIN_EXAMPLE
(where :title "Give Us a Break" :ripped t)
#+END_EXAMPLE
と呼ぶと，clausesの値は以下となる。
#+BEGIN_EXAMPLE
(:title "Give Us a Break" :ripped t)
#+END_EXAMPLE
マクロ展開の値を確認
関数macroexpand-1を使う。
macroexpand-1にマクロ呼び出しのフォームを渡すと，
展開されたものが返る。
#+BEGIN_EXAMPLE
CL-USER> (macroexpand-1 '(where :title "Give Us a Break" :ripped t))
#'(LAMBDA (CD)
(AND (EQUAL (GETF CD :TITLE) "Give Us a Break")
(EQUAL (GETF CD :RIPPED) T)))
T
#+END_EXAMPLE
最終更新：2012年06月21日 15:15
