- Book "Land of Lisp"
-
09章-より進んだデータ型とジェネリックプログラミング
-
10章-loopマクロ
-
11章-format関数でテキストを表示する
-
12章-ストリーム
-
13章-Webサーバを作ろう！
-
15章-ダイスオブドゥーム：関数型スタイルでゲームを書こう
-
16章-マクロの魔法
-
17章-ドメイン特化言語
-
18章-遅延プログラミング
-
19章-ダイスオブドゥームにグラフィカルなWebインターフェースをつける
-
20章-ダイスオブドゥームをさらに面白く
-
Last active
July 21, 2018 19:08
-
-
Save otaon/e6128ef26b799d2acec2cceb92fd2a49 to your computer and use it in GitHub Desktop.
Book/LandOfLisp
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Common Lisp では、下記のようなデータ型が使用できる。
- コンスセル
- シンボル
- 文字列
- 数値
- 配列
- ハッシュテーブル
- 構造体
配列を作成するにはmake-arrayを使用する。
> (make-array 3)
#(NIL NIL NIL)配列を作成する。
> (defparameter x (make-array 3))
X配列の1番目の要素をgetする。
> (aref x 1)
NILCommon Lispはジェネリックなセッターをサポートしている。
つまり、あらゆるデータ型に対してセッターが同じ形式で書ける。
例として、setfによって、配列の特定の要素を変更する。
> (defparameter x (make-array 3))
> (setf (aref x 1) 'foo)
FOO
> x
#(NIL 'FOO NIL)
> (aref x 1)
FOO上記の例では、配列の第1要素を変更した。
下記の通り、配列以外のデータ型に対しても、setfは同様の操作によって値をセットできる。
> (setf foo (make-array 4))
#(NIL NIL NIL NIL)
> (setf (aref foo 2) (list 'x 'y 'z))
(X Y Z)
> foo
#(NIL NIL (X Y Z) NIL)
> (setf (car (aref foo 2)) (make-hash-table))
#S(HASH_TABLE)
> (setf (gethash 'zoink (car (aref foo 2))) 5)
5
> foo
#(NIL NIL (#S(HASH-TABLE (ZOINK . 5)) Y Z) NIL)配列とリストでは、特定の要素にアクセスする方法が異なる。
具体的には、下記の違いがある。
| n番目の要素へのアクセス | |
|---|---|
| リスト | (nth 数字 リスト) |
| 配列 | (aref 配列 数字) |
ハッシュテーブルを作成するにはmake-hash-tableを使用する。
> (make-hash-table)
#S(HASH-TABLE ...)alistと同じく、ハッシュテーブルは要素をキーとバリューの組み合わせで格納する。
gethash関数を使って要素を取り出すことができる。
> (defparameter x (make-hash-table))
#S(HASH-TABLE ...)
> (gethash 'yup x)
NIL ;
NILgethashは2つの値を返す関数である。
1つ目の値は、キーに対応する値。
2つ目の値は、キーに対応する値があるか否か。
配列と同じように、データを取り出す関数(ここではgethash)を、setfを組み合わせてデータをセットできる。
> (defparameter x (make-hash-table))
#S(HASH-TABLE ...)
> (setf (gethash 'yup x) '25)
25
> (gethash 'yup x)
25 ;
T同じデータを連想リストとハッシュテーブルで作成してみる。
alist
> (defparameter *drink-order* '((bill . double-espresso)
(lisa . small-drip-coffee)
(john . medium-latte)))
> (cdr (assoc 'lisa *drink-order*))
(LISA . SMALL-DRIP-COFFEE)hash-table
> (defparameter *dring-order* (make-hash-table))
#S(HASH-TABLE ...)
> (setf (gethash 'bill *drink-order*) 'double-espresso)
DOUBLE-ESPRESSO
> (setf (gethash 'lisa *drink-order*) 'small-drip-coffee)
SMALL-DRIP-COFFEE
> (setf (gethash 'john *drink-order*) 'medium-latte)
MEDIUM-LATTE
(gethash 'lisa *drink-order*)
SMALL-DRIP-COFFEE ;
TCommon Lispでは、複数の値を返す関数を定義できる。
既成の関数でも、複数の値を返すものがある。
> (round 2.4)
2 ;
0.4複数の値を返す関数を自作するには、(values)を使用する。
> (defun foo ()
(values 3 7))
FOO
> (foo)
3 ;
71番目の値を使用する方法は、単数の返り値の扱い方と変わらない。
> (+ (foo) 5)
82番目以降の値を使用するには(multiple-value-bind)を使用する。
> (multiple-value-bind (a b) (foo)
(* a b))
21構造体は、OOPに見られるように、属性を持つオブジェクトを表現するために使用される。
構造体を定義するには(defstruct)を使用する。
スロットに初期値を与える場合、括弧で囲う。
> (defstruct person
name
age
waist-size
favorite-color)
PERSON
> (defstruct human
(name "John Doe")
age
waist-size
favorite-color)
HUMAN上記の例では、personは4つの属性(lispにおいてはスロットと呼ばれる)を持つ。
- name 名前
- age 年齢
- waist-size ウェストサイズ
- favorite-color 好きな色
構造体を定義する(defstructを呼ぶ)と、下記が自動的に生成される。
(make-person)関数
> (defparameter *bob* (make-person :name "Bob"
:age 35
:waist-size 32
:favorite-color "blue"))
*BOB*(person-age)関数
> (person-age *bob*)
35
> (setf (person-age *bob*) 36)
36LispのReaderは、personの出力表記を読み込み、personのインスタンスを生成できる。
> (defparameter *that-guy* #S(PERSON :NAME "bob" :AGE 35 :WAIST-SIZE 32 :FAVORITE-COLOR "blue"))
> (person-age *that-guy*)
35仮に、構造体を使用せずにリストでデータの塊を管理することを考える。
この場合、インスタンスを作成する関数や、各スロットへのゲッターは下記のとおり書ける。
> (defun make-person (name age waist-size favorite-color)
(list name age waist-size favorite-color))
MAKE-PERSON
> (defun person-age (person)
(cadr person))
PERSON-AGE見て分かる通り、どの属性がpersonリストのどの位置にあるのかを意識する必要がある。
したがって、リストで沢山の属性を管理するのはバグの原因となる。
また、構造体の方がリストよりも属性へのセット、ゲットのコードが簡潔に書ける。
したがって、複数の属性を持つミュータブルなデータを管理したい場合、リストよりも構造体が適している。
ジェネリック = 一般的。
Common Lispでは、様々なデータ型を意識せずに、数値を統一的に操作できる。
そのための道具立てとして、下記のようなものが用意されている。
- ジェネリックライブラリ関数
- 型述語
defmethod- ジェネリックアクセサ
引数のデータ型によらず動作するコードを手軽に書くには、型チェックを別の関数に任せれば良い。
Common Lispには、ジェネリックな関数が既に用意されている(e.g. シーケンス関数)。
シーケンス関数は、Lispにおける3つの主要なシーケンスを統一的に扱える(e.g. length関数)。
(シーケンス: リスト 配列 文字列)
> (length '(a b c))
3
> (length "blub")
4
> (length (make-array 5))
5補足:
Common Lispにも、リスト専用の長さを求める関数list-lengthがある。
ジェネリックな関数よりも処理が速いが、始めから使用する必要はない。
処理の最適化のフェーズで明確に必要だと分かったら使用すれば良い。
シーケンス関数の中には、シーケンスから何かを探し出すためのものがある。
find-if与えられた述語を満たす最初の要素を見つけるcount特定の要素がいくつシーケンス中にあるか数えるposition特定の要素がシーケンスのどの位置にあるか返すsomeシーケンス中に条件を満たす要素が存在するか返すeveryシーケンス中の全要素が条件を満たすか返す
上記の関数の実行例を示す。
> (find-if #'numberp '(a b 5 d))
5
> (cound #\s "mississippi")
4
> (position #\4 "2kewl4skewl")
5
> (some #'numberp '(a b 5 d))
T
> (every #'numberp '(a b 5 d))
NILジェネリックなシーケンス関数において、reduceはとりわけ便利である。
> (reduce #'+ '(3 4 6 5 2))
20reduceの第1引数に渡す関数を、縮約関数(reduction function)と呼ぶ。
上記の例では、+が縮約関数である。
reduceでは、initial-valueというキーワード引数を使って、初期値を与えられる。
初期値を与えなかった場合は、シーケンスの最初の要素を初期値とする。
下記に、リスト(a b c)に初期値xを与えなかった場合と与えた場合の処理の違いを示す。
| 初期値 | 処理内容(tは一時変数) |
|---|---|
| 無し | t=a t=t+b t=t+c |
| 有り | t=x t=t+a t=t+b t=t+c |
下記の通り、初期値を与えないと、aが初期値として設定されたまま結果として返されてしまう。
例えば、縮約関数が「シーケンスの中で最大の偶数を見つける」だった場合、初期値は必須である。
(lambda (best item)
(if (and (evenp item) (> item best))
item
best))
; initial-valueが無い場合
; '(7 4 6 5 2)
; 7 <- (> item best)がTとならないため
; initial-valueが0の場合
; '(7 4 6 5 2)
; 6 <- 正しく評価できたreduceをpythonで手続き的に記載すると、下記のようになる。
def func(a, b):
return a + b
def reduce(func, lst, **kwargs):
if 'initial_value' in kwargs.keys():
lst.insert(0, kwargs['initial_value'])
temp = lst[0]
for i in range(len(lst) - 1):
temp = func(temp, lst[i + 1])
return temp
lst = [i + 1 for i in range(10)]
print(reduce(func, lst))
# => 55
print(reduce(func, lst, initial_value=10))
# => 65mapはmapcarと同じく、各要素を引数に渡した関数を呼んで結果を集める。
しかし、mapは任意のシーケンスに対して使用できる。
また、mapは返り値としてどのシーケンス型の値を返すかという引数を取る。
> (map 'list
(lambda (x)
(if (eq x #\s)
#\S
x))
"this is a string")
(#\t #\h #\i #\S #\ #\i #\s #\ #\a #\ #\S #\t #\r #\i #\n #\g)subseq関数は始点と終点を指定してシーケンスの一部分を取り出すのに使える。
位置は0から数え始め、始点は含まれ、終点は含まれない。
> (subseq "america" 2 6)
"eric"sort関数は任意の比較関数を渡してシーケンスをソートする。
> (sort '(5 8 2 4 9 3 6) #'<)
(2 3 4 5 8 9)Common Lispは動的型付け言語であるため、ある変数のデータ型を調べる関数が揃っている。
例えば数値かどうかはnumberpによって調べられる。
> (numberp 5)
Tよく使う型述語には下記がある。
arraypcharacterpconspfunctionphash-table-plistpstringpsymbolp
これらを使えば、色々な型の引数をジェネリックに取る関数を自分で書ける。
例えば、数値同士とリスト同士を「足す」関数を作るとする。
単純に関数定義するなら、下記のようになる。
> (defun add (a b)
(cond ((and (numberp a) (numberp b)) (+ a b))
((and (listp a) (listp b)) (app a b))))
ADD
> (add 3 4)
7
> (add '(a b) '(c d))
(A B C D)上記の関数は、複数の型に対する処理が固まっているため、保守性が低い。
そこで、lispは関数の 多重定義(オーバーロード) が可能なので、これを利用する。
defmethodを使うと各々の型に特化した複数の関数を定義できる。
defmethodによって定義された関数が呼ばれたとき、Lispは自動的に引数の型を調べ、対応する関数本体を呼び出す。
このように、インタプリタ/コンパイラは複数の関数本体から引数の型に応じたものを選び出すことを、 型によるディスパッチ(type dispatching) と呼ぶ。
defmethodを使うと、上記のaddは下記のようになる。
> (defmethod add ((a number) (b number))
(+ a b))
ADD
> (defmethod add ((a list) (b list))
(append a b))
ADD
> (add 3 4)
7
> (add '(a b) '(c d))
(A B C D)defmethodは、上記9.3章のdefstructで定義した構造体に対しても使用できる。
これを使用して、簡単なオブジェクトシステムを実装することも出来る。
書籍では、loopマクロで使えるトークンを周期表のようにまとめていた。
それだと少々見辛いため、素直な表形式で下記にまとめなおす。
| トークン | 説明 |
|---|---|
loop |
単純なループ |
do doing |
繰り返しの中で任意の式を実行する |
repeat |
指定した回数ループする |
return |
任意の式の実行結果を返してループを抜ける |
initially |
ループし始める前に任意の式を実行する |
finally |
ループが終わった後に任意の式を実行する |
| ループの途中脱出時には実行されない | |
with |
ローカル変数を作成する |
into |
結果を格納するローカル変数を作成する |
(loop (princ "type something")
(force-output)
(read))
; type somethingr
; type somethingf
; type somethingf
; ...(loop for i below 5
do (print i))
; 0
; 1
; 2
; 3
; 4
; NIL
; CL-USER> (loop repeat 5
do (print "Print five times"))
; "Print five times"
; "Print five times"
; "Print five times"
; "Print five times"
; "Print five times"
; NIL(loop for i below 10
when (= i 5)
return 'leave-early
do (print i))
; 0
; 1
; 2
; 3
; 4
; LEAVE-EARLY(loop initially (print 'loop-begin)
for x below 3
do (print x))
; LOOP-BEGIN
; 0
; 1
; 2
; NIL(loop for x below 3
do (printx)
finally (print 'loop-end))
; 0
; 1
; 2
; LOOP-END
; NIL(loop with x = (+ 1 2)
repeat 5 do (print x))
; 3
; 3
; 3
; 3
; 3
; NIL(loop for i in '(1 1 2 3 5)
minimize i into lowest
maximize i into biggest
finally (return (cons lowest biggest)))
; (1 . 5)| トークン | 説明 |
|---|---|
named |
ループに任意の名前をつける |
return-from |
ループ名を指定してループを抜ける |
while |
式が真ならループを続け、nilならループを抜ける |
until |
式がnilならループを続け、真ならループを抜ける |
(loop named outer
for i below 10
do (progn (print "outer")
(loop named inner
for x below i
do (print "**inner")
when (= x 2)
do (return-from outer 'kicked-out-all-the-way))))
; "outer"
; "outer"
; "**inner"
; "outer"
; "**inner"
; "**inner"
; "outer"
; "**inner"
; "**inner"
; "**inner"
; KICKED-OUT-ALL-THE-WAY省略。
namedの例を参照のこと。
(loop for i in '(0 2 4 555 6)
while (evenp i)
do (print i))
; 0
; 2
; 4
; NIL(loop for i from 0
do (print i)
until (> i 3))
; 0
; 1
; 2
; 3
; 4
; NIL
(loop for i from 0
until (> i 3)
do (print i))
; 0
; 1
; 2
; 3
; NIL| トークン | 説明 |
|---|---|
using |
hash-keyによりキーを、hash-valueによりバリューを保持する |
being |
ハッシュテーブルから、being the hash-key ofでキーを、being the hash-value ofでバリューを取得する |
the each |
ハッシュテーブルに対してbeing theかbeing eachとしてアクセスする |
hash-keys hash-key |
ハッシュキーを取得する際に指定するトークン |
hash-values hash-value |
ハッシュ値を取得する際に指定するトークン |
下記の例では全てsalaryハッシュテーブルを使用する。
(defparameter salary (make-hash-table)
(setf (gethash 'bob salary) 80)
(setf (gethash 'john salary) 90)(loop for person being each hash-key of salary
using (hash-value amt)
do (print (cons person amt))))
; (JOHN . 90)
; (BOB . 80)
; NIL(loop for person being each hash-key of salary
do (print person))
; JOHN
; BOB
; NIL(loop for person being each hash-key of salary
do (print person))
; JOHN
; BOB
; NIL(loop for person being the hash-keys of salary
do (print person))
; JOHN
; BOB
; NIL省略。
the eachの例を参照のこと。
(loop for amt being each hash-value of salary
do (print amt))
; 90
; 80
; NIL(loop for amt being the hash-values of salary
do (print amt))
; 90
; 80
; NIL| トークン | 説明 |
|---|---|
for as |
ループ変数を初期化する |
in |
リストをcarしたものをループ変数に与える |
on |
リストをループ変数に与えた後にcdrする |
by |
数:指定した数値だけループ変数を増減させる（デフォルト:1or-1） |
リスト:指定した関数でリストから値を取り出す（デフォルト:#'cdr） |
|
then |
for x = y then zとすると、xに初期値yを設定し、式zを繰り返し実行する |
from |
for x from y to zとして、ループ変数xを数値yから増減させる |
upfrom |
for x upfrom y to zとして、ループ変数xを数値yから増加させる |
downfrom |
for x downfrom y to zとして、ループ変数xを数値yから減少させる |
to |
for x from y to zとして、ループ変数xを数値zまで増減させる |
upto |
for x from y to zとして、ループ変数xを数値zまで増加させる |
downto |
for x from y to zとして、ループ変数xを数値zまで減少させる |
across |
for x across yとして、シーケンス（文字列を含む）yを先頭からxに与える |
(loop for i from 0
do (print i)
when (= i 5)
return 'zuchini)
; 0
; 1
; 2
; 3
; 4
; 5
; ZUCHINI(loop as i from 5
to 10
collect x)
; (0 1 2 3 4 5 6 7 8 9 10)(loop for i in '(100 20 3)
sum i)
; 123(loop for x in '(1 3 5)
do (print x))
; 1
; 3
; 5
; NIL
(loop for x on '(1 3 5)
do (print x))
; (1 3 5)
; (3 5)
; (5)
; NIL(loop for i from 6 to 8 by 2
sum i)
; 14(loop repeat 5
for x = 10.0
then (/ x 2)
collect x)
; (10.0 5.0 2.5 1.25 0.625)(loop for i from 6 to 8
sum i)
; 21(loop for i upfrom 6 to 8
sum i)
; 21(loop for i downfrom 10 to 7
do (print i))
; 10
; 9
; 8
; 7
; NIL省略。
fromの例を参照のこと。
(loop for i from 6 upto 8
sum i)
; 21(loop for i from 10 downto 7
do (print i))
; 10
; 9
; 8
; 7
; NIL(loop for i across #(100 20 3) ; 配列
sum i)
; 123| トークン | 説明 |
|---|---|
always |
式が真ならばループを続け、nilならばループを抜ける |
never |
式がnilならばループを続け、真ならばループを抜ける |
thereis |
式が真ならばループを抜ける |
| 返り値は真偽値ではなく、判定に用いた値自体 |
(loop for i in '(0 2 4 6)
always (evenp i))
; T(loop for i in '(0 2 4 6)
never (oddp i))
; T(loop for i in '(0 2 555 6)
thereis (oddp i))
; T| トークン | 説明 |
|---|---|
if when |
式が真ならば、その次の節を実行する |
unless |
式がnilならば、その次の節を実行する |
and |
条件を満たした時に実行する節を複数記述する場合に、節を連結する |
else |
condマクロのように条件節を連結する |
end |
複数記述した節の終わりを示す |
(loop for i below 5
if (oddp i)
do (print i))
; 1
; 3
; NIL(loop for i below 4
when (oddp i)
do (print i)
do (print "yup"))
; "yup"
; 1
; "yup"
; "yup"
; 3
; "yup"
; NIL(loop for i below 4
unless (oddp i)
do (print i))
; 0
; 2
; NIL(loop for i below 5
when (= x 3)
do (print "do this")
and do (print "also do this")
do (print "always do this"))
; "always do this"
; "always do this"
; "always do this"
; "do this"
; "also do this"
; "always do this"
; "always do this"
; NIL(loop for i below 5
if (oddp i)
do (print i)
else do (print "w00t"))
; "w00t"
; 1
; "w00t"
; 3
; "w00t"
; NIL(loop for i below 4
when (oddp i)
do (print i)
end
do (print "yup"))
; "yup"
; 1
; "yup"
; "yup"
; 3
; "yup"
; NIL| トークン | 説明 |
|---|---|
count counting |
式がnil以外の場合に累積的に数を数える |
sum summing |
数値を加算していく |
minimize minimizing |
後ろに続く数が前の数値よりも小さい場合、その数を残す |
maximize maximizing |
後ろに続く数が前の数値よりも大きい場合、その数を残す |
append appending |
次に続くリストを結果となるリストに連結する（非破壊的） |
nconc nconcing |
次に続くリストを結果となるリストに連結する（破壊的） |
(loop for i in '(1 1 1 1)
count i)
; 4(loop for i below 5
sum i)
; 10(loop for i in '(3 2 1 2 3)
minimize i)
; 1(loop for i in '(3 2 1 2 3)
maximize i)
; 3(loop for i below 5
append (list 'Z i))
; (Z 0 Z 1 Z 2 Z 3 Z 4)(loop for i below 5
nconc (list 'Z i))
; (Z 0 Z 1 Z 2 Z 3 Z 4)- 11.1
format関数の呼び出し方 - 11.2 制御シーケンス: Lispの値 を表示する
- 11.3 制御シーケンス: 数値を整形する
- 11.4 複数行出力
- 11.5 テキストを揃える
- 11.6 制御シーケンス: 繰り返し
- 11.7 綺麗な表を作るクレージーな整形トリック
format関数の構文と制御シーケンスを説明する。
下記にformat関数の構文を示す。
(format t "Add onion rings for only ~$ dollars more!" 1.5)- nil
- 生成されたテキストを文字列として返す。
- t
- 結果をコンソールに出力する。返り値はnilとなる。
- stream
- データを出力ストリームに書き出す。
"......"の部分は制御文字列といい、原則としてテキストはそのまま出力される。
ただし、制御文字列の中に 制御シーケンス を使用することで、出力形式に影響を与える。
制御シーケンスは常に~で始まる。
制御文字列の後ろの引数は、実際の値、つまり整形され表示されるデータである。
制御文字列に従ってこれらの値は解釈、整形される。
ここからは、制御シーケンスについて解説する。
- ~s
- (print1)と同じく、Lispが後から読み込めるような区切り文字も入っている。
- ~a
- (princ)と同じく、人間が読みやすい形式で表示する。
> (format t "I am printing ~s in the middle of this sentence." "foo")
I am printing "foo" in the middle of this sentence.
> (format t "I am prining ~a in the middle of this sentence." "foo")
I am printing foo in the middle of this sentence.- ~aや~sの前の整数n (例:~10a)
- 出力の最小値の指定。値をフォーマットした文字列が整数nに満たなければ、スペースが右側に追加される。
~aの例 制御シーケンスの部分が10文字になるように、fooの右に空白が7個追加される。
> (format t "I am prining ~10a within ten spaces of room." "foo")
I am printing foo within ten spaces of room.
^^^^^^^- 第1パラメータ
- 整数n
出力の最小幅を指定する。パディングにはスペースが使われる。 - 第2パラメータ
- 整数n
パディングのステップ数を指定する。
パディングは全体の表示幅が第1パラメータ以上になるまで続く。 - 第3パラメータ
- 整数n
パディング文字数の下限を指定する。
全体の表示幅ではなく、パディング文字数自体の下限であることに注意。 - 第4パラメータ
- '文字
パディングに使用する文字を指定する。最初に'をつけることに注意。 - , (カンマ)
- 各パラメータのセパレータ
- @ (アットマーク)
- パディング文字を左側に挿入することを指定する。
下記の制御シーケンスを用いることで、様々な基数で数値を表示できる。
- ~x
- 16進数で数値を表示する。
- ~b
- 2進数で数値を表示する。
- ~d
- 10進数で数値を表示する。
数値用の制御シーケンス特有のパラメータが用意されている。
- : (コロン)
- 制御シーケンス文字の前に:を入れると、3桁ごとにカンマを入れる。
下記の制御シーケンスを用いることで、様々な基数で数値を表示できる。
- ~f
- 浮動小数点を表示する。
浮動小数点用のパラメータを以下に示す。
- 第1パラメータ
- 小数(整数部と小数点を含む)の表示幅。例えばPIに4を指定したら3.14と表示される。
- 第2パラメータ
- 小数点以下の表示幅。例えばPIに4を指定したら3.1416と表示される。(四捨五入される!)
- 第3パラメータ
- 数値を10^指定値倍する。例えばPIに2を指定したら100倍され314.16と表示される。
下記の制御シーケンスを用いることで、小数を含む通貨表示を指定できる。
- ~$
- "ドル.セント"の形式で表示する。1.5は1.50と表示される。
Lispのコマンドとして、改行には2つ(terpriとfresh-line)がある。
- terpri
- 現在の行を終了して、続く出力が新たな行に現れるようにする。
- fresh-line
- 現在のカーソルが行頭いないときに限って改行する。
formatコマンドでは、terpriとfresh-lineそれぞれに対応する制御シーケンスがある。
- ~%
- (terpriに相当)
現在の行を終了して、続く出力が新たな行に現れるようにする。 - ~&
- (fresh-lineに相当)
現在のカーソルが行頭いないときに限って改行する。
さらに、これら二つの制御シーケンスには改行数を指定するパラメータがある。
- 第1パラメータ
- 改行数を指定する。~5%として、5つの空行を出力する。
formatコマンドでは、テキストを揃える制御シーケンスがある。
例えばテーブルを作ったり、センタリングしたりする制御シーケンスがある。
ここでは下記のリストを使用して説明する。
(defun random-animal ()
(nth (random 5) '("dog" "tick" "tiger" "walrus" "kangaroo")))- ~t
- テキストが現れる位置を指定する。
- 第1パラメータ
- 整形後のテキストが現れるカラム位置。カラム位置は行頭から数える。
> (loop repeat 10
do (format t "5t~a ~15t~a ~25t~a~%"
(random-animal)
(random-animal)
(random-animal)))
; walrus tick dog
; dog dog tick
; tiger tiger kangaroo
; kangaroo tick tiger
; tiger walrus tiger
; dog tick kangaroo
; tiger walrus dog
; walrus tiger dog
; walrus dog dog
; walrus tick dog
;NIL文字がなるべく等しい距離をとって表示するようにするには、~<と~>制御シーケンスを使用する。
- ~<, ~>
- ~<と~>で囲まれた文字列を文字寄せする。
- ~<の第1パラメータその1
- 整数n
~<と~>で囲まれたブロックの幅を指定する。
例えば30と指定すると、ブロック全部で30文字分の幅を使用する。 - ~<の第1パラメータその2
- :@
行全体に対して値をセンタリングする。文字列ごとではないことに注意。 - ~;
- ~<による文字寄せ対象となる新たな値が次に来ることを示す。(~;は文字寄せ用の空白を挿入する、と考えても良い。)
3つの文字列を30文字分の幅に配置する
(loop repeat 10
do (format t "~30<~a~;~a~;~a~>~%"
(random-animal)
(random-animal)
(random-animal)))
;kangaroo dog dog
;tiger tiger kangaroo
;tiger kangaroo walrus
;tiger kangaroo kangaroo
;tick kangaroo tiger
;kangaroo walrus tick
;walrus walrus walrus
;tick walrus tiger
;tick tick tiger
;walrus kangaroo dog
;NIL3つの文字列を30文字分の幅に中央揃えで配置する
(loop repeat 10
do (format t "~30:@<~a~;~a~;~a~>~%"
(random-animal)
(random-animal)
(random-animal)))
; tiger tick dog
; tiger dog tiger
; tiger dog walrus
; dog kangaroo tick
; kangaroo tiger tiger
; walrus tick walrus
; tick walrus tick
; tiger tick tick
; dog tick kangaroo
; walrus walrus kangaroo
;NILformatではループを実現する制御シーケンスがある。
- ~{, ~}
- ~{と~}で囲まれた制御文字列とリストを与えると、formatはリスト中のデータをループで処理する。
以下にループの例を示す。
(defparameter *animals* (loop repeat 10 collect (random-animal)))
*animals*
;("tiger" "dog" "tiger" "tick" "walrus" "walrus" "tiger" "tiger" "dog" "tiger")
;; リスト中の文字列を1ループにつき1つずつ取り出して整形する
(format t "~{I see a ~a!~%~}" *animals*)
;I see a tiger!
;I see a dog!
;I see a tiger!
;I see a tick!
;I see a walrus!
;I see a walrus!
;I see a tiger!
;I see a tiger!
;I see a dog!
;I see a tiger!
;NIL
;; リスト中の文字列を1ループにつき2つずつ取り出して整形する
(format t "~{I see a ~a... or was it a ~a?~%~}" *animals*)
;I see a tiger... or was it a dog?
;I see a tiger... or was it a tick?
;I see a walrus... or was it a walrus?
;I see a tiger... or was it a tiger?
;I see a dog... or was it a tiger?
;NIL(format t "|~{~<|~%|~,33:;~2d ~>~}|" (loop for x below 100 collect x))
;| 0 1 2 3 4 5 6 7 8 9 |
;|10 11 12 13 14 15 16 17 18 19 |
;|20 21 22 23 24 25 26 27 28 29 |
;|30 31 32 33 34 35 36 37 38 39 |
;|40 41 42 43 44 45 46 47 48 49 |
;|50 51 52 53 54 55 56 57 58 59 |
;|60 61 62 63 64 65 66 67 68 69 |
;|70 71 72 73 74 75 76 77 78 79 |
;|80 81 82 83 84 85 86 87 88 89 |
;|90 91 92 93 94 95 96 97 98 99 |
;NIL上表は、以下の制御シーケンスによって表示される。
| 制御シーケンス | 制御内容 |
|---|---|
| |
最初に|を表示する |
~{ |
ループ制御を始める |
~< |
1行ごとの文字揃えを始める |
|~%| |
|改行|を表示する |
~,33:; |
33文字分出力したらこの制御シーケンスに先立つ文字列を表示する |
~2d |
2桁の数値と を表示する |
~> |
1行ごとの文字揃えを終わる |
~} |
ループ制御を終わる |
| |
最後に|を表示する |
REPLによる入出力、ディスク上のファイルの読み書き、LANやインターネットの通信において、
Common Lispでは ストリーム を使用する。
本ドキュメントでは、ストリームの種類、使い方を説明する。
Common Lispでは、リソースの種類に合わせて、いくつかのストリーム型が用意されている。
また、ストリームの向きにも種類がある。
- リソースにデータを書き出す(write)
- リソースからデータを読み込む(read)
- リソースとデータを読み書きする(read/write)
リソースの種類に応じて、ストリームの型を分類する。
- コンソールストリーム
- 標準入出力。
REPLとやりよりするのに使っていたストリーム。 - ファイルストリーム
- ディスク上のファイルの読み書きに使うストリーム。
- ソケットストリーム
- ネットワークを通じて他のコンピュータと通信するのに使うストリーム。
- 文字列ストリーム
- Lispの文字列からテキストを読み出したり、文字列へと書き込んだりするストリーム。
リソースに対するストリームの向きによってストリームを分類する。
- 出力ストリーム
- リソースにデータを書き出すストリーム。
- 入力ストリーム
- リソースからデータを読み込むストリーム。
出力ストリームは、REPLに文字を表示したり、ファイルに書き出したり、ソケットを通じてデータを送ったりするのに使われる。
出力ストリームの最も基本的な操作は下記の2つのみである。
他のLispのデータ型に比べると、できる操作が限られているが、むしろこれによりストリームが色々と応用できる。
| 基本操作 | コマンド |
|---|---|
| 出力ストリームか否かを調べる | output-stream-p |
| データをストリームへと送る | write-char |
REPLには*standard-output*と呼ばれる出力ストリームが結び付けられている。
次のコードにより、これが有効な出力ストリームか否かを調べることができる。
> (output-stream *standard-output*)
TLispの文字はwrite-charを使って出力ストリームに送ることができる。
文字#\xを*standard-output*ストリームに送り出すには、次のコードを実行する。
> (write-char #\x *standard-output*)
xNILこのコードは、xを標準出力に書き出す。
この関数の戻り値nilがxのすぐ次に表示されているが、これは単なるwrite-charの戻り値。
他にも、バイナリデータなどを操作することもできる。
入力ストリームは、データを読み出すために使う。
出力ストリームと同様、入力ストリームに対して行える操作も限られている。
| 基本操作 | コマンド |
|---|---|
| 入力ストリームか否かを調べる | input-stream-p |
| ストリームからデータを1つ取り出す | read-char |
REPLには*standard-input*と呼ばれる入力ストリームが結び付けられている。
次のコードにより、これが有効な入力ストリームか否かを調べることができる。
> (input-stream-p *standard-input*)
Tread-charを使って入力ストリームから1文字取り出すことができる。
次のコードでは、REPLから読み込んでいるため、[enter]キーを押すまでデータが標準入力ストリームに届かないことに注意。
> (read-char *standard-input*)
123[enter]
#\1[enter]を押すと、入力ストリームの先頭にある#\1がread-charにより返される。
ストリームに使える他のコマンド
write-charやread-char以外にも、Common Lispにはストリームを扱うコマンドが多く備わっている。
例えば、printコマンドに*standart-output*を渡して出力先を指定することができる。
> (print 'foo *standard-output*)
FOOストリームを使うことで、ファイルの読み書きもできる。
Common Lispでファイルストリームを作成するのに良い方法としては、with-open-fileコマンドを使うことである。
> (with-open-file (my-stream "data.txt" :direction :output)
(print "my data" my-stream))この例では、出力ストリームを作ってmy-streamという変数に格納している。
このストリームはwith-open-fileの閉じ括弧まで有効である。
そして、このストリームに送られたデータは、ディスク上の"data.txt"というファイルに書き出される。
with-open-fileの:directionに:outputを渡すと出力ストリームが作られる。
with-open-fileの:directionに:inputを渡すと入力ストリームが作られる。
> (with-open-file (my-stream "data.txt" :direction :input)
(read my-stream))もう少し複雑な例を次に示す。
> (let ((animal-noises '((dog . woof)
(cat . meow))))
(with-open-file (my-stream "animal-noises.txt" :direction :output)
(print animal-noises my-stream)))
((DOG . WOOF)(CAT . MEOW))
> (with-open-file (my-stream "animal-noises.txt" :direction :input)
(read my-stream))
((DOG . WOOF)(CAT . MEOW))作ろうとしたファイルが既に存在した場合にどうするかを指定するには:if-existsキーワードを指定する。
ファイルが既に存在した場合はエラーとする
> (with-open-file (my-stream "data.txt" :direction :output :if-exists :error)
(print "my data" my-stream))
*** - OPEN: file #P"/home/user/data.txt" already existsファイルが既に存在した場合でも強制的に上書きする
> (with-open-file (my-stream "data.txt" :direction :output :if-exists :supersede)
(print "my data" my-stream))
"my data"実はCommon Lispにもファイルをオープンしたりクローズする低レベルコマンドはある。
with-open-fileはそれらを隠蔽している。
もしもwith-open-file中でエラーが発生してもファイルを確実にクローズして、リソースを開放してくれる。
標準的なネットワークにあるコンピュータと通信するためには、ソケットを用意する必要がある。
ANSI Common Lispの仕様化にソケットの標準化は間に合わなかったため、標準の方法は存在しない。
ここでは、CLISPののソケットコマンドについて説明する。
ネットワーク上のソケットには ソケットアドレス が割り当てられている。
ソケットアドレスは、次の2つの要素からなる。
- IPアドレス
- ネットワーク上でコンピュータ（厳密にはNIC）を一意に指定する番号
- ポート番号
- プログラムが、同じコンピュータ上の他のプログラムと区別するために使用する番号
2つのプログラム間でソケットを使ってメッセージをやりとりするには、コネクション を初期化する必要がある。
- 一方のプログラムがソケットを作ってそれをListenすることで、もう一方のプログラムが通信を始めるのを待つ
(ソケットをListenするプログラムはサーバと呼ばれている) - もう一方のプログラムはクライアントと呼ばれ、自分自身が使うソケットを作った後、サーバとコネクションを確立する
まず、2つのCLISPを立ち上げる。
一方をクライアント、もう一方をサーバとする。
NOTE 必ずCLISPを使用すること。
サーバ側では、socket-serverを呼ぶことで、指定したポートの使用権を得る。
> (defparameter my-socket (socket-server 4321)) ; ON THE SERVER
MY-SOCKETこのコマンドでは、オペレーティングシステムからポート4321を得て、ソケットをそのポートに束縛する。
作られたソケットは変数my-socketに格納され、この後の例で使えるようになる。
NOTE このコマンドは危険である。
なぜなら、ソケットを使用し終えた後、自分でOSに返却する必要がある。
さもなくば、他の誰もソケットに結び付けられたポートを使えなくなる。
もしも何か手違いがありポートに束縛したソケットをおかしくしてしまったら、新しくソケットを作るときは別のポート番号を選ぶか、コンピュータを再起動しなければならないかもしれない。
（Common Lispの例外システムにより、この問題を回避することはできる。）
（CLISPプロセスを一度終了すれば、いずれOSはこのポートを再利用するが、ポートの状態によっては再利用できるようになるまでしばらく時間がかかるかもしれない。）
次に、サーバ側で、このソケットに接続したクライアントとの通信を扱うストリームを作る。
socket-acceptを実行すると、サーバ側はREPLプロンプトに戻ってこず、クライアントが接続してくるまでlisten中となる。
> (defparameter my-stream (socket-accept my-socket)) ; ON THE SERVER
MY-STREAM次は、クライアント側でsocket-connectコマンドを使ってサーバのソケットに接続する。
このコマンドを実行したら、すぐにサーバ側のsocket-accept関数が戻ってきて、my-stream変数がセットされる。
> (defparameter my-stream (socket-connect 4321 "127.0.0.1")) ; ON THE CLIENT
MY-STREAMNOTE IPアドレス127.0.0.1は常に現在のコンピュータ自身を指している特殊なIPアドレスである。
ここでCLISPによって作成されたこれらのストリームは、 双方向ストリーム である。
つまり、入力ストリームとしても出力ストリームとしても振る舞い、通信するためにどちらのストリーム用のコマンドも使用できる。
クライアントからサーバに気軽な挨拶を送ってみる。
> (print "Yo Server!" my-stream)
"Yo Server!"そしてサーバ側では次のコマンドを実行する。
> (read my-stream)
"Yo Server!"次は、サーバ側で次のようにタイプする。
> (print "What up, Client!" my-stream)
"What up, Client!"クライアント側に戻って、これを実行する。
> (read my-stream)
"What up, Client!"一連の手順を終えると、サーバ側、クライアント側のプロンプトには次のようになっている。
サーバ側
> (defparameter my-socket (socket-server 4321))
MY-SOCKET
> (defparameter my-stream (socket-accept my-socket))
MY-STREAM
> (read my-stream)
"Yo Server!"
> (print "What up, Client!" my-stream)
"What up, Client!"クライアント側
> (defparameter my-stream (socket-connect 4321 "127.0.0.1")) ; ON THE CLIENT
MY-STREAM
> (print "Yo Server!" my-stream)
"Yo Server!"
> (read my-stream)
"What up, Client!"今ソケットで送信したのは文字列だったが、他にも標準のLispデータ構造なら何でも全く同じようにやりとりできる。
以上の例で作成したリソースをきちんと開放しておくことは重要である。
次のコマンドをクライアントとサーバ双方で実行して、両端のストリームを閉じる。
> (close my-stream)
T次に、サーバ側でsocket-server-closeを実行し、ポートを返却してソケットを開放する。
さもなくば、リブートするまでポート4321が使えなくなる。
> (socket-server-close my-socket)
NIL大抵のストリームは、Lispプログラムが 外の世界 とやりとりするために使うものである。
しかし、文字列ストリームは例外で、これは単に文字列をストリームのように見せるだけのものである。
他のストリームが外部のリソースを読み書きするのと同じ方法で、文字列ストリームは文字列を読み書きできる。
文字列ストリームはmake-string-output-streamと、make-string-input-streamで作ることができる。
次の例では、make-string-output-streamを使っている。
> (defparameter foo (make-string-output-stream))
> (princ "This will go into foo. " foo)
> (princ "This will also go into foo. " foo)
> (get-output-stream-string foo)
"This will go into foo. This will also go into foo."Lispは文字列を直接操作できるのに、なぜこのような機能が必要なのか？
しかし、文字列ストリームには利点がある。これらの利点を次に示す。
ストリームを引数に期待している関数に対して、文字列ストリームを渡すことができる。
これは、ファイルやソケットを読み書きする関数をデバッグする際にとても役立つ。
なぜなら、本物のファイルやソケットの代わりに文字列を入出力データとして与えたり受け取ったりできるからである。
例えば、write-to-logという関数があったとする。
普通はログ情報はファイルストリームへと送って、ファイルにセーブされるようにするだろう。
しかし、この関数をデバッグする際には、代わりに文字列ストリームを渡してやれば出力された文字列を読むことで動作確認できる。
write-to-logが常にファイルに出力されるようにハードコードしてしまうと、こういった柔軟性がなくなってしまう。
関数を書くときは、外部リソースを直接リソースを直接アクセスするのではなく、可能な限りストリームを使うように書いておく方が良い。
非常に長い文字列を作る場合、文字列ストリームを使う方が効率の良いコードになる。
たくさんの文字列を1つずつ繋いでいくのは非常に効率が悪くなる。これは、文字列を繋ぐ度に文字列用のメモリをアロケートするからだ。
NOTE このため、多くのプログラミング言語では 文字列ビルダ と呼ばれる機能を用意して、このオーバヘッドを避けている(JavaのStringBuilderなど)。
文字列ストリームを、特にwith-output-to-stringと一緒に使うと、読みやすくデバッグしやすいコードが書ける。
ここで、with-output-to-stringを使ったコードを次に示す。
> (with-output-to-string (*standard-output*)
(princ "the sum of ")
(princ 5)
(princ " and ")
(princ 2)
(princ " is ")
(princ (+ 2 5)))
"the sum of 5 and 2 is 7"with-output-to-stringマクロは、コンソール、REPL、他のストリームに向かうはずだった出力を横取りして、それを文字列として格納して返す。
上の例ではwith-output-to-stringの本体内でprincにより出力されるデータが自動的に文字列ストリームへと向けられる。
with-output-to-stringの本体の実行が終わると、文字列ストリームに蓄積された出力が文字列として返される。
with-output-to-stringは、また、長く複雑な文字列を組み立てるときにも使える。
本体中で文字列の部分部分をprintしていって、最後に集められた出力を文字列として得られる。
文字列の断片をconcatenateしていくよりも読みやすく効率の良いコードになる。
NOTE with-output-to-stringは関数プログラミングの精神とは逆行している。
Webサーバのように外部とやりとりする場合、予想外の自体が起きる可能性がある。
Common Lispにはコード内で例外を扱う機能が豊富に備わっている。
Common Lispの例外システムは柔軟である。
関数内で何か問題が起きた時、Lisp関数はLispの実行環境に問題が発生したことを伝える。 この手段が コンディションを通知する ことである。 (コンディションは、他の言語では例外(exception)と呼ばれるオブジェクトと同じようなもの)
自分で書いたコードで、どうしても処理を続けられない場合が、コンディションを通知するときである。
自分の書くコードから直接コンディションを通知するには、errorコマンドを使う。
errorコマンドは、他の場所でエラーを横取りしていなければ、Lispプログラムの実行を中断する。
コンディションを通知して、エラーの説明メッセージとして"foo"を表示してみる。
> (error "foo")
*** - foo
The following restarts are available:
ABORT R1: Abort main loop
>上の例の通り、コンディションの通知によってLispシステムはプログラムを中断し、メッセージ"foo"を出力した後、REPLにエラープロンプトを表示する。
(CLISPでは、この時点で:aをタイプすればプログラムの実行を放棄して通常のREPLに戻る。)
最初の例では、コンディションを説明する文字列をerror関数に渡した。
しかし、単にテキストでエラーメッセージを表示するだけでは、どういったコンディションかを判断するのは難しい。
そこで、Common Lispでは、コンディションの型を定義して、その型に応じて異なる処理をすることができる。
最初に次の例のようにdefine-conditionでコンディションの型を定義する。
ここではコンディションをfooと名付けた。
> (define-condition foo () ()
(:report (lambda (condition stream)
(princ "Stop FOOing around, numbskull!" stream))))
FOO定義したコンディションが通知されたときにどう表示されるかを制御する、専用の関数を定義できる。
上の例では、lambdaを使ってその関数を定義した。
lambda関数の中では、専用のエラーメッセージを表示するようにした。
このコンディションを通知してみる。
[5]> (error 'foo)
*** - Stop FOOing around, numbskull!
The following restarts are available:
ABORT :R1 Abort main loop
Break 1 [6]> :a
[7]>この通り、専用のメッセージが表示された。この方法を使えば、コンディションの型に応じてより分かりやすいメッセージを表示できる。
define-conditionでコンディション型を定義したときに名前（上の例ではfoo）を与えた。
この名前を使えば、この型のコンディションが通知されたときに、プログラムを中断する代わりに実行する処理を、プログラムの上位層で書いておくことができる。
そのためのコマンドがhandler-caseである。
handler-caseコマンドの第1引数には、横取りしたいコンディションを通知するかもしれないコードを与える。（下の例ではbad-function）
handler-caseの残りの部分には、特定のコンディションが通知されたときに何をすべきかを列記する。
> (defun bad-function ()
(error 'foo))
BAD-FUNCTION
> (handler-case (bad-function)
(foo () "somebody signaled foo!")
(bar () "somebody signaled bar!"))
"somebody signaled foo!"このhandler-caseが呼び出されるとbad-functionが呼び出され、その中の(error 'foo)によってfooコンディションが通知される。
もしhandler-caseがなかったら、この時点でプログラムが中断されてREPLにエラープロンプトが表示されることになっていたが、
この例では、handler-caseがfooコンディションを横取りして、プログラムは中断されることなく、"somebody signaled foo!"という結果が返る。
予想外の例外が発生した場合、プログラムがクラッシュしたり、下手すると外部のリソースを壊してしまう。
例えば、ファイルやソケットストリームに何かを書いている最中に例外が発生したと想定する。
この時、ストリームを正しくクローズしてファイルハンドルやソケットを解放してやる必要がある。
リソースが正しい手順でクリーンアップされないと、そのリソースをユーザが再び使いたい場合はコンピュータをリブートする必要がある、という場合もある。
このような「想定外のコンディションからリソースを保護する」ために使うのが、unwind-protectコマンドである。
このコマンドは、Common Lispコンパイラに「このコードだけは絶対に実行しろ」と伝えるものである。
下記の通り、unwind-protectの中でゼロ除算を行った場合、コンディションを通知する。
しかし、エラープロンプトからCLISPに実行の放棄を指示した後、重要なメッセージが表示されていることがわかる。
> (unwind-protect (/ 1 0) ; division by zero
(princ "I need to say 'flubyduby' matter what"))
*** - /: division by zero
The following restarts are available:
ABORT :R1 Abort main loop
Break 1 [8]> :r1
I need to say 'flubyduby' matter what
[9]> Common Lispのwith-マクロを使っている場合、そのマクロが内部でunwind-protectを呼んでくれることが多いため、直接unwind-protectを使用する場面はあまりない。
（16章ではunwind-protectのようなマクロを実際に作成する）
HTTP(Hypertext Transfer Protocol)は、Webページをやりとりするために使われるインターネットのプロトコルである。 確立されたソケットコネクションを通じて、TCP/IPの上でページをやりとりするを定義している。 クライアント上で走っているプログラム(Webブラウザなど)が定められた形式に沿ったリクエストを送ると、サーバは要求されたページを作り出して、ソケットストリームを通じてレスポンスを返す。
NOTE: このWebサーバはRon Garretのhttp.lispを元にしている。
例えば、ブラウザがクライアントとして、lolcats.htmlというページを要求したとする。
リクエストメッセージは次のような内容になっているはずである。
これらのサーバに送られるメッセージ全体は リクエストヘッダ と呼ばれる。
GET /lolcats.html HTTP/1.1
Host: localhost:8080
User-Agent: Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.9.0.5)
Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip,deflate
Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7
Keep-Alive: 300
Connection: keep-alive最初の行は リクエストライン と呼ばれる。 ここには、リクエストの種類(GET)と、要求するページの名前(lolcats.html)が含まれている。
GET /lolcats.html HTTP/1.12行目以降は、 HTTPヘッダフィールド と呼ばれる。 行頭からコロンまでの箇所にヘッダ、コロンの右側に内容がある。
Host: localhost:8080
User-Agent: Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.9.0.5)
Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip,deflate
Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7
Keep-Alive: 300
Connection: keep-aliveリクエストヘッダに続いて、 リクエストボディ と呼ばれる部分を使って他の情報を送ることもできる。
サーバは、クライアントからリクエストを受け取ったら、 レスポンスヘッダ (Webブラウザは受け取ったドキュメントに関する追加情報)と レスポンスボディ (Webページを表現するHTMLドキュメント)を返信する。 ただし、今回作っているWebサーバでは、ヘッダを生成せずにただボディだけを返す。
レスポンスボディ の一例を示す。
<html>
<body>
Sorry dudez, I don't have any LOLZ for you today :(
</body>
</html>ここで、Webサイトに次のログインフォームを作ることを考える。
--------------------------------
| userid [ ] |
| password [ ] |
| [submit] |
--------------------------------
サイトを訪れた人がSubmitボタンをクリックすると、ブラウザはPOSTリクエストやGETリクエストをWebサーバに送信する。
POSTリクエストは前節で説明したGETリクエストによく似ている。 ただ、POSTリクエストはサーバにあるデータに変更を加えたいときに使われる。
今のログインフォームの例では、訪問者がフォームのテキストフィールドに記入したユーザIDとパスワードをサーバに送る必要がある。 フィールドに記入された値は、POSTリクエストの リクエストパラメータ として送られる。 つまり、POSTリクエストヘッダの後ろにある、リクエストボディに当たる部分が使われる。
次に、このログインフォームによって送られるPOSTリクエストの例を示す。
POST /lolcats.html HTTP/1.1
Host: www.mywebsite.com
User-Agent: Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.9.0.5)
Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip,deflate
Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7
Keep-Alive: 300
Connection: keep-alive
Content-Length: 39
userid=foo&password=supersecretpassword最後の行は、リクエストパラメータである。
POSTリクエストのヘッダに追加の情報が付加されている。
Content-Lengthは、リクエストのボディに含まれるデータの長さを表す。
ここではContent-Length: 39となっているので、リクエストパラメータの大きさが39バイトであることをサーバに知らせている。
リクエストパラメータは主としてPOSTリクエストでサーバにデータを送るために使われている。 しかし、GETリクエストにもリクエストパラメータを入れることもできる。 POSTリクエストでは、パラメータはリクエストボディの中に隠されているが、GETリクエストでは、パラメータはリクエストのURLに含まれる。
例えば、Googleで"dogs"と検索したい場合、リクエストされるページのURLに?q=dogsといった値が入っている。
これがリクエストパラメータである。
ここで作るWebサーバは、POSTリクエストパラメータと、GETリクエストパラメータの両方とも扱えるようにする。
HTTPでフォームのデータを送る場合、通常のアルファベット以外の文字はHTTPエスケープコードと呼ばれる特殊形式に変換される(RFC3986)。 エスケープコードを使うことで、HTTPフォーマットでは特別な文字を持つような文字もデータとして送ることができる。
例えば、ユーザがfoo?とテキストフィールドにタイプした場合、リクエストにはfoo%3Fという文字列が送られる。
ここではクエスチョンマークがエスケープされている。
Webサーバは、このようなエスケープされた文字をデコードできなければならない。
では、デコードする関数を次に示す。
英語版リクエストパラメータデコーダ
(defun http-char (c1 c2 &optional (default #\Space))
"16進数で表されたASCIIコードをデコードする
c1: 2桁目の数値となる文字
c2: 1桁目の数値となる文字"
;; 16進数の文字列を整数へと変換する
(let ((code (parse-integer
(coerce (list c1 c2) 'string)
:radix 16 ; 数の基数を指定
:junk-allowed t))) ; 数値の解釈を失敗した時、エラー通知ではなくnilを返す
;; 整数への変換が成功したら、そのコードに対応した文字を返す
;; 整数への変換が失敗したら、default値を返す
(if code
(code-char code)
default)))
(defun decode-param-en (s)
"httpエスケープされているリクエストパラメータをデコードする(ASCIIコードのみ対応)"
;; f: 文字のリストを再帰的に処理するローカル関数
(labels ((f (lst)
(when lst
;; 文字が%なら、次に2桁の16進数で表されるASCIIコードをデコードする
;; 文字が+なら、空白文字として解釈する
;; 他の文字なら、そのまま出力する
(case (car lst)
;; リストの先頭の文字を処理し、残りの文字列（処理済み）と組み合わせる
(#\% (cons (http-char (cadr lst) (caddr lst))
(f (cdddr lst))))
(#\+ (cons #\space
(f (cdr lst))))
(otherwise (cons (car lst)
(f (cdr lst))))))))
;; リストの要素を文字列として結合する
(coerce (f (coerce s 'list)) 'string)))日本語版リクエストパラメータデコーダ
;; 文字ごとではなく、バイトごとにデコードする(URLの正式なエンコーディング準拠)
(defun http-byte (c1 c2 &optional (default #\Space))
"16進数で表された文字をバイト数値にデコードする
c1: 2桁目の数値となる文字
c2: 1桁目の数値となる文字"
;; 16進数の文字列を整数へと変換する
(let ((code (parse-integer
(coerce (list (code-char c1) (code-char c2)) 'string)
:radix 16 ; 数の基数を指定
:junk-allowed t))) ; 数値の解釈を失敗した時、エラー通知ではなくnilを返す
;; 整数への変換が成功したら、そのコードに対応したバイト数値を返す
;; 整数への変換が失敗したら、default値を返す
(or code default)))
(defun decode-param-ja (s)
"httpエスケープされているリクエストパラメータをデコードする(マルチバイト文字対応)"
;; f: 文字のリストを再帰的に処理するローカル関数
(labels ((f (lst)
(when lst
;; 文字が%なら、次に2桁の16進数で表されるASCIIコードをデコードする
;; 文字が+なら、空白文字として解釈する
;; 他の文字なら、そのまま出力する
(case (car lst)
;; リストの先頭の文字を処理し、残りの文字列（処理済み）と組み合わせる
(#.(char-code #\%) (cons (http-byte (cadr lst) (caddr lst))
(f (cdddr lst))))
(#.(char-code #\+) (cons #.(char-code #\space)
(f (cdr lst))))
(otherwise (cons (car lst)
(f (cdr lst))))))))
;; リストの要素を文字列として結合する
(ext:convert-string-from-bytes
(coerce (f (coerce (ext:convert-string-to-bytes s charset:utf-8) 'list)) 'vector)
charset:utf-8)))NOTE: CLISPで端末のエンコーディングを設定するには、下記コマンドを使う。
;; charsetには下記などが使える。
;; charset:utf-8
;; charset:euc-jp
;; charset:shift-jis
> (setf *terminal-encoding* charset:utf-8)NOTE: Webサーバで日本語を表示するためには、ソケットの文字エンコーディングも指定する必要がある。
serveコマンド（後述）を起動する前に、REPL上で次のコマンドを実行すること。
> (setf *default-file-encoding* charset:utf-8)
#<ENCODING CHARSET:UTF-8 :UNIX>NOTE: ここで扱っているHTTPエスケープコードは、Lisp文字列のエスケープ文字とは無関係。
リクエストパラメータには、"name=bob&age=25&gender=male"といった具合に、名前/値の組が複数含まれている。
このようなパラメータは、Webページの末尾にもよく含まれている。
ここでは、これらの組をリストとして取り出す。
データ構造としては連想リスト(alist)と同じである。
そこで、リクエストパラメータの文字列を解釈してalistを返す関数を作る。
(defun parse-params (s)
"リクエストパラメータのalistを返す
s: リクエストパラメータの文字列
ret: リクエストパラメータのalist"
(let ((i1 (position #\= s)) ; リクエストパラメータ中の=の位置
(i2 (position #\& s))) ; リクエストパラメータ中の&の位置
(cond (i1 (cons ; 名前と値の各コンスセルをコンスする
(cons (intern (string-upcase (subseq s 0 i1))) ; car部：名前をシンボルに変換したもの
(decode-param (subseq s (1+ i1) i2))) ; cdr部：値のhttpエスケープをデコードしたもの
(and i2 (parse-params (subseq s (1+ i2)))))) ; 残りのリクエストパラメータに対して処理
((equal s "") nil) ; リクエストパラメータが空になったらリストを閉じるためにnilを返す
(t s)))) ; リクエストパラメータの書式ではない文字列の場合、文字列をそのまま返すdecode-paramでは、文字列を文字のリストとして変換してから処理した。
parse-paramsでは、文字列をそのまま扱う。
position関数は、文字列から指定した文字を探してその位置を返す関数である。
これを使って、渡された文字列から&と=の位置を求めている。
i1がnilでない、つまり、=が見つかったら、それは文字列中に名前/値のペアが見つかったということになる。
この場合、subseqを使って名前と値それぞれを切り出す。
名前部分についてはintern関数を使って文字列をLispのシンボルに変換する。
値部分についてはhttpエスケープをデコードする。
これらを実行すると、次のような結果になる。 このようにリクエストのパラメータををalistに治すことで、後から特定のパラメータの値を取り出しやすくなる。
> (parse-params "name=bob&age=25&gender=male")
((NAME . "bob") (AGE . "25") (GENDER . "male"))NOTE: 上のparse-param関数では、簡略化のために、名前部分がエスケープされている可能性を無視していることに注意。
次は、リクエストヘッダの最初の行(リクエストライン)である、GET /lolcats.html HTTP/1.1といった文字列を解析する。
次に示すparse-request-line関数によって行う。
(defun parse-request-line (s)
"リクエストヘッダのリクエストラインからURLを取り出す
s: リクエストライン
ret: url本体部とリクエストパラメータ部とのコンスセル"
(let* ((url (subseq s
(+ 2 (position #\space s)) ; スペース位置から2つ進んだ箇所(`/`の次)
(position #\space s :from-end t))) ; 文字列の後ろから見てスペースのある箇所
(x (position #\? url))) ; URL中のリクエストパラメータの開始位置
(if x ; リクエストパラメータがある
(cons (subseq url 0 x) (parse-params (subseq url (1+ x)))) ; url本体部とリクエストパラメータ部とのコンスセル
(cons url '())))) ; url本体部と空リストとのコンスセルこの関数では、まず、リクエストヘッダのリクエストラインを受け取り、最初にスペースを探し出して、URL部分を抜き出す。
次に ?を探し、もし存在すればそれ以降はリクエストパラメータなので、切り出してparse-paramsに渡す。
GET /lolcats.html HTTP/1.1
^^^^^^^^^^^^
car部
> (parse-request-line "GET /lolcats.html HTTP/1.1")
("lolcats.html")
> (parse-request-line "GET /lolcats.html?extra-funny=yes HTTP/1.1")
("lolcats.html" (EXTRA-FUNNY . "yes"))次に、リクエストヘッダのHTTPヘッダフィールドを処理する。
次に示すget-headerは、リクエストヘッダの残りの行を読み込んでalistにして返す関数である。
(defun get-header (stream)
"リクエストヘッダのHTTPヘッダフィールドからリクエストパラメータを返す
stream: HTTPヘッダフィールド
ret: リクエストパラメータと値とのコンスセル"
(let* ((s (read-line stream)) ; 入力ストリームから得た文字列1行分
(h (let ((i (position #\: s))) ; コロンの位置
(when i ; コロンがある場合、コロンを区切りとしたリクエスト名/値のコンスセルを作る
(cons (intern (string-upcase (subseq s 0 i)))
(subseq s (+ i 2)))))))
;; コンスセルができたら、残りのリクエストも処理する
;; コンスセルができなかったら、それ以降はリクエストは無いなずなので、処理を終わる
(when h
(cons h (get-header stream)))))get-header関数はソケットストリームから直接データを読み込む想定である。
したがって、そのままではREPLでテストできない……と思うかもしれない。
ここで、前章でやったことを利用する。
Common Lispでは、ソケット以外にも異なる種類のリソースを扱う何種類化のストリームが有る。
ストリームはどれも同じインターフェースでアクセスできるため、ソケットストリームの代わりに文字列ストリームを渡して、get-headerをテストできる。
> (get-header (make-string-input-stream "foo: 1
bar: abc,123
"))
((FOO . "1") (BAR . "abc,123"))make-string-input-stream関数で、リテラル文字列から入力ストリームを作り出している。
この例では、文字列は2つのキー(fooとbar)を含み、HTTPヘッダの形式通り、空行で終わっている。
(Common Lispではリテラル文字列を複数行に渡って書くことができる。)
POSTリクエストでは、パラメータはリクエストヘッダの後、リクエストボディやリクエストコンテントと呼ばれる領域を使って送られる。
次のget-content-params関数によって、そこからパラメータを取り出す。
(defun get-content-params (stream header)
"リクエストヘッダの後にあるリクエストボディから、パラメータを取り出す
stream: ストリーム
header: HTTPヘッダフィールドの連想リスト"
(let ((length (cdr (assoc 'content-length header)))) ; HTTPヘッダフィールドからコンテンツの長さを取得する
;; もしcontent-lengthがHTTPヘッダフィールドにあれば、リクエストパラメータの連想リストを作る
(when length
(let ((content (make-string (parse-integer length)))) ; 与えられた長さの文字列を`make-string`で作成する
(read-sequence content stream) ; ストリームからデータを読み込んで、contentを満たす
(parse-params content))))) ; リクエストパラメータの連想リストを作るこの関数は、リクエストボディに含まれるパラメータの長さを示すcontent-hengthヘッダを探す。
もしcontent-lengthヘッダがリクエストヘッダに見つかれば、処理すべきリクエストパラメータが存在するということになる。
その場合、与えられた長さの文字列をmake-stringで作成し、read-sequenceを使ってストリームからデータを読み込む。
最後に、読み込まれた文字列に対してparse-paramsを使って、リクエストパラメータの連想リストを作る。
ここまでで必要な機能は実装した。
ここでは、Webサーバの核となるserve関数を実装する。
この関数は、引数にとったリクエストハンドラに、パス、HTTPヘッダフィールド、パラメータを使った処理を委譲する。
(defun serve (request-handler)
"request-handler: リクエストハンドラ。解析したリクエストを使う。"
(let ((socket (socket-server 8080))) ; サーバのポート番号
(unwind-protect ; 例外時にソケットが確実に閉じられるようにする
(loop (with-open-stream (stream (socket-accept socket)) ; 接続が確立したらソケットオブジェクトをstreamにセットする
(let* ((url (parse-request-line (read-line stream))) ; streamからURLとリクエストパラメータを得る
(path (car url)) ; URLのパス部
(header (get-header stream)) ; HTTPヘッダフィールド
(params (append (cdr url) ; URL末尾(GET用)とリクエストボディ(POST用)のリクエストパラメータ
(get-content-params stream header)))
(*standard-output* stream)) ; ストリームを標準出力に設定
(funcall request-handler path header params)))) ;
(socket-server-close socket))))ここまでで作ったWebサーバを動かしてみる。
(defun hello-request-handler (path header params)
"名前を問いかけて、得られたその名前を使って挨拶する
CAUTION! リクエストパラメータをサニタイズしていないため、WANでの使用不可
path: URLのパス部分
header: HTTPヘッダフィールド
params: URL末尾(GET用)とリクエストボディ(POST用)のリクエストパラメータ
ret: レスポンスするHTMLドキュメント"
(declare (ignore header)) ; 本関数ではHTTPヘッダフィールドは無視する
;; "/greeting"ページのみ提供する
(if (equal path "greeting")
;; ページが"greeting"ならパラメータに合わせて表示処理を行う
(let ((name (assoc 'name params)))
(if (not name)
;; パラメータにnameが無ければ、もう一度名前を問いかける
(princ "<html><form>What is your name?<input name='name' /></form></html>")
;; パラメータにnameがあれば、挨拶を表示する
(format t "<html>Nice to meet you, ~a!</html>" (cdr name))))
;; ページが"greeting"でなければ、要求されたページが無い旨を表示する
(princ "Sorry... I don't know that page.")))クロージャは、lambdaで関数が作られるとき、外側の情報を捕獲したものである。
まずは、普通の関数を定義する。これは、5を返す関数である。
> (defparameter *foo* (lambda ()
5))
*FOO*
> (funcall *foo*)
5次に、示す関数は、クロージャの実装例である。
最初にローカル変数xを作り、それに5を代入している。
そして、lambdaの本体から、xの値を参照して返している。
> (defparameter *foo* (let ((x 5))
(lambda ()
x)))
*foo*
> (funcall *foo*)
5上の通り、クロージャでは関数が定義された時に参照した変数を捕捉している。
この動作は、Lispがガベージコレクタを持っていることを考えると理解しやすい。
ガベージコレクタは、アロケートされた変数がどこからも参照されなくなると、メモリを解放する。
上の例では、letの中でlambdaを使っている。
この場合、letを抜けても、変数はlambdaの中から参照されている。
したがって、ガベージコレクタは変数を回収しない。
そして、lambda自身がガベージコレクタに回収されるまでは変数も生き続けることになる。
クロージャを使うことで、関数に紐づけたスタティック変数があるかのような処理を実装できる。
下の例では、関数が呼ばれる度に、捕捉した行番号を表示しつつインクリメントする。
> (let ((line-number 0))
(defun my-print (x)
(print line-number)
(print x)
(incf line-number)
nil))
MY-PRINT
> (my-print "this")
0
"this"
nil
> (my-print "is")
1
"is"
nil
> (my-print "a")
2
"a"
nil
> (my-print "a")
3
"test"
nilメモ化とは、関数が受け取った引数と、その結果を記録しておくテクニックである。 このテクニックは、副作用がない関数(=関数型プログラミングによる関数)に対して使える。 また、このテクニックは、クロージャを使って実現できる。
まずは、与えられたマスから攻撃可能な隣り合うマスを計算するneighbors関数をメモ化してみる。
> (neighbors 0)
(3 1 4)上のとおり、neighborsに引数0を渡した時の返り値は(3 1 4)となる(ゲーム盤が3x3の場合)。
また、この関数は不変のゲーム盤に対する不変的な位置計算をするものであるため、メモ化の対象とできる。
neighbors関数をメモ化したものを下に示す。
(let ((old-neighbors (symbol-function 'neighbors))
(previous (make-hash-table)))
(defun neighbors (pos)
(or (gethash pos previous)
(setf (gethash pos previous) (funcall old-neighbors pos)))))最初に定義したレキシカル変数のsymbol-functionは、引数のシンボルに束縛されている関数を取り出すコマンドである。
したがって、old-neighbors変数には、この行が評価されるよりも前に定義したneighborsが束縛される。
つまり、この後に同名のneighbors関数を再定義しても、以前のバージョンの定義にアクセスできるという寸法である。
次に定義したレキシカル変数のpreviousは、渡された引数とその結果とを全て保存していくためのハッシュテーブルである。
このハッシュテーブルは、引数をキー、結果を値とする。
そして、新たにneighbors関数を定義して以前のバージョンのneighborsを上書きする。
この新しい定義のneighbors関数は、以前の定義のneighbors関数にメモ化処理を加えたものである。
この新しい定義のneighbors関数は、はじめに、引数posを使ってハッシュテーブルを調べる。
既に値が登録されていれば、その引数をキーとした値を取り出して返す。
未だ値が登録されていなければ、その引数を使ってold-neighbors(つまり以前のバージョンのneighbors)を呼び出した結果を、引数をキーとしてハッシュテーブルに登録する。
setfはセットされた値を返すから、最後の式では、ハッシュテーブルへ登録すると同時にold-neighborsの返り値を返している。
ゲーム木を計算する関数において、同じゲーム木を何度も計算するのは全くの無駄な処理である。
そこで、game-tree関数をメモ化して、同じゲーム木を見つけたらそのゲーム木の枝を共有することとする。
下に、game-tree関数をメモ化するコードを示す。
(let ((old-game-tree (symbol-function 'game-tree))
(previous (make-hash-table :test #'equalp))) ; キーの比較関数にequalpを使う
(defun game-tree (&rest rest)
(or (gethash rest previous)
(setf (gethash rest previous) (apply old-game-tree rest)))))ハッシュテーブルのキーの比較関数にequalp関数を使用したのは、キーがゲーム盤を含む配列であるからである。
テスト関数にequalpを使えば、ゲーム盤の全てのマスの同値性を比較して、完全一致した時に以前の計算結果が使われるようにできる。
また、old-game-tree関数には引数が複数あるため、&rest restと表記することでリストrestとして扱っている。
そして、applyによりリストrestを個々の引数としてold-game-treeに適用している。
最後に、メモ化する効果が高いrate-positionをメモ化することを考える。
メモ化のコードは下のとおりである。
;; クロージャとして補足する値: 特定のプレイヤーに対する特定のゲーム木に対応する点数のハッシュテーブル
(let ((old-rate-position (symbol-function 'rate-position))
(previous (make-hash-table)))
(defun rate-position (tree player)
(let ((tab (gethash player previous))) ; 引数のプレイヤーについての返り値の記憶を辿る
;; 引数のプレイヤーについての返り値が記憶されていなければ、
;; 引数のプレイヤー用のハッシュテーブルを新規作成する
(unless tab
(setf tab (setf (gethash player previous) (make-hash-table))))
;; 引数のプレイヤーについて、引数のゲーム木が記憶されていれば、それに対応する値を返す
;; 記憶されていなければ、引数のプレイヤーと引数のゲーム木に対応する戻り値を新たに計算して記憶し、
;; それを返り値とする
(or (gethash tree tab)
(setf (gethash tree tab)
(funcall old-rate-position tree player))))))rate-positionには問題がある。
rate-positionの引数であるtreeはゲーム木であるため、非常に大きなデータである可能性がある。
また、game-treeで使用したequalpは同値性の比較をするため、大きなデータに対しては比較コストが非常に高い。
したがって、これをgame-treeと同様にequalp(同値性比較)で比較すると、キーの比較だけで処理が増大してしまい、メモ化の効果が薄れる可能性がある。
ところで、先程のgame-tree関数のメモ化によって、同値のゲーム木は必ず同一のインスタンスとなることが保証されている。
そこで、rate-positionの引数のうち、treeは、デフォルトのeql(低コストな同一性比較)で済むようにしたい。
なお、残りの引数playerはシンボルであるため、player単体ならば既にデフォルトのeqlで比較可能である。
(treeとplayerをコンスしたりしてしまうと同一性が保てない点に注意。)
そこで、rate-position関数の2つの引数(treeとpalyer)を別々に記憶しておくようにしたい。
上のコードでは、ネストしたハッシュテーブルを使用してそれを実現している。
下に、このハッシュテーブルの構造を示す。
; ネストしたハッシュテーブルの構造
; previous = #S((player1 . tab1)
; (player2 . tab2))
; tab = #S((tree1 . ret1)
; (tree2 . ret2))
> previous
#S((プレイヤーID-1 . #S((ゲーム木a . 返り値1-a)
(ゲーム木b . 返り値1-b)))
(プレイヤーID-2 . #S((ゲーム木c . 返り値2-c)
(ゲーム木d . 返り値2-d))))NOTE: メモ化は、関数型スタイルで書かれたコードの最適化に使えるテクニックであるが、メモ化するコード自体は 以前の計算結果 という状態を持つため、関数型では書けない。
ここでは、 末尾再帰最適化 と呼ばれる、関数型プログラミングの最適化テクニックを説明する。
このテクニックを理解するために、リストの長さを求める簡単な関数を考えてみる。
> (defun my-length (lst)
(if lst
(1+ (my-length (cdr lst)))
0))
MY-LENGTH
> (my-length '(fie foh fum))
3じつは、この関数はかなり非効率である。
試しに、とても大きなリストにこの関数を適用すると、CLISPではプログラムがクラッシュする。
;; 注意:このプログラムはクラッシュするので実行しないこと!!
> (defparameter *biglist* (loop for i below 100000 collect 'x))
*BIGLIST*
> (my-length *biglist*)
*** - Program stack overflow. RESETなぜクラッシュするのか。
それは、再帰された関数を呼び出す際に現在の関数の情報をスタックに積むからである。
スタックに積み上げたデータが取り出されるのは、関数が終了した時であるから、関数が再帰的に呼び出され続けていればスタックオーバーフローを起こす。
ただし、処理系によってはスタックオーバーフローが起こらないように設計されている。
この問題を回避したバージョンのmy-lengthを以下に示す。
> (defun my-length (lst)
(labels ((f (lst acc) ; アキュムレータ
(if lst ; このlstはfのローカル変数
(f (cdr lst) (1+ acc))
acc)))
(f lst 0)))
MY-LENGTH
> (my-length '(fie foh fum))
3このバージョンでは、リストを走査するローカル変数fを定義して、それを再帰的に呼び出している。
この関数fは、入力リストに加え、余分な引数accを取る。
このaccはアキュムレータ(accumlator)と呼ばれる。
引数accは、それまでにいくつのリストの要素に出会ったかを数えている。
一番最初にfを呼び出すとき、accは0である。
アキュムレータを使うと、関数fが自分自身を再帰的に呼び出す際にその結果を受け取って1を加算しなくても良い。
代わりに、引数accに1を加算した値を再帰呼び出しの引数へと渡していく。
リストの最後に到達したら(listがnil)、引数のaccはリストの要素数と同じになっているから、このaccをそのまま返せば良い。
(accumlator(アキュムレータ)とは、CPUの演算回路を構成するレジスタの一種で、論理演算や四則演算などによるデータの入出力と結果の保持に用いられるレジスタのことである。)
(accumlate: 蓄積する。)
このバージョンで大事なのは、「リストが空ではない場合、fの最後の処理が 自分自身を呼び出すこと である」ということである。
Lispの関数が、その最後の処理として自分自身や他の関数を呼び出すとき、それを末尾呼び出しと呼ぶ。
末尾呼び出しの場合、Lispでは現在の状態をスタックに積み上げず、すぐにfの処理に取り掛かる。
これは、C言語のlongjumpやBASICのGOTOに相当する動きである。
現在の状態をスタックに積み上げない場合、スタック操作が無い分非常に速く、そもそもスタックを消費せずに済む。
また、Lispの末尾呼び出しはlongjumpやGOTOとは違い、構造化プログラミングの範疇となり、安全な処理のままである。
また、上の例のlstは、下の通り2種類の意味で使われている。
my-lengthの引数fの引数
したがって、fの内部では、lstはfの引数として扱われる。
このように、同じ名前の変数があるときに近い方の引数が優先されることを、「変数の シャドウイング 」という。
Common Lispにおいては、コンパイラ/インタプリタが末尾呼び出しを最適化することを常に期待できない。
何故なら、ANSI Common Lispでは、末尾再帰最適化を要求していないからである。
(Schemeでは、その規格において末尾呼び出し最適化を厳密に要求している)
ただし、ほとんどのCommon Lispの処理系では、末尾呼び出し最適化をサポートしている。
CLISPでは、末尾呼び出し最適化を有効にするために、以下のコードを実行する必要がある。
(compile 'my-length)わざわざ末尾呼び出し最適化を有効にするためにコード実行が必要である理由としては、末尾呼び出し最適化が性能上の問題を引き起こすケースが存在するからである。
また、プログラムをデバッグする際には、スタックにはなるべく多くの情報が保存されていた方が良いに決まっているが、末尾呼び出し最適化を施してしまうと、その情報は失われてしまう。
ダイス・オブ・ドゥームで末尾呼び出し最適化の効果が大きく現れるのは、add-new-dice関数である。
まずは、末尾呼び出し最適化していないバージョンのadd-new-dice関数を示す。
(defun add-new-dice (board player spare-dice)
"ゲーム盤にサイコロを足していく
board: 現在のゲーム盤情報
player: 現在のプレイヤーID
spare-dice: 補給できるサイコロの個数
ret: サイコロ追加後のゲーム盤情報"
(labels ((f (lst n)
;; lst: ゲーム盤情報(リスト)
;; n: 補給できるサイコロの個数
;; ゲーム盤情報が無ければ、そのまま無し(nil)を返す
;; 補給できるサイコロが無ければ、ゲーム盤情報を返す
;; その他の場合、サイコロを補給する
(cond ((null lst) nil)
((zerop n) lst)
(t (let ((cur-player (caar lst)) ; 現在のプレイヤーID
(cur-dice (cadar lst))) ; 着目中のマスのサイコロの個数
(if (and (eq cur-player player) (< cur-dice *max-dice*))
;; 着目中のマスが現在のプレイヤーのマス、かつ、
;; マスにおけるサイコロの個数が上限でなければ、
;; サイコロを追加して次のマスへ移動
(cons (list cur-player (1+ cur-dice))
(f (cdr lst) (1- n)))
;; そうでなければ、サイコロを追加せずに次のマスへ移動
(cons (car lst) (f (cdr lst) n))))))))
;; ゲーム盤情報をリストに変換して、
;; サイコロを追加して、
;; ゲーム盤情報を再び配列に戻す
(board-array (f (coerce board 'list) spare-dice))))次に、末尾呼び出し最適化を施したadd-new-dice関数を以下に示す。
(defun add-new-dice (board player spare-dice)
"ゲーム盤にサイコロを足していく
board: 現在のゲーム盤情報
player: 現在のプレイヤーID
spare-dice: 補給できるサイコロの個数
ret: サイコロ追加後のゲーム盤情報"
(labels ((f (lst n acc)
;; lst: ゲーム盤情報(リスト)
;; n: 補給できるサイコロの個数
;; acc: 新たなサイコロの追加を考慮された、更新済みのマスのリスト(右下->左上の順)
(cond
;; 補給できるサイコロが無ければ、ゲーム盤情報を返す
((zerop n) (append (reverse acc) lst))
;; ゲーム盤を最後まで走査したら、サイコロ追加後のゲーム盤情報を返す
((null lst) (reverse acc))
;; その他の場合、サイコロを補給する
(t (let ((cur-player (caar lst)) ; 現在のプレイヤーID
(cur-dice (cadar lst))) ; 着目中のマスのサイコロの個数
(if (and (eq cur-player player) (< cur-dice *max-dice*))
;; 着目中のマスが現在のプレイヤーのマス、かつ、
;; マスにおけるサイコロの個数が上限でなければ、
;; サイコロを追加して次のマスへ移動
(f (cdr lst) ; サイコロを足していく対象のゲーム盤のうち未走査部分
(1- n) ; 補給できるサイコロを1減らす
(cons (list cur-player (1+ cur-dice)) acc)) ; 更新済みのマスのリスト
;; そうでなければ、サイコロを追加せずに次のマスへ移動
(f (cdr lst) ; サイコロを足していく対象のゲーム盤のうち未走査部分
n ; 補給できるサイコロ
(cons (car lst) acc)))))))) ; 更新済みのマスのリスト
;; ゲーム盤情報をリストに変換して、
;; サイコロを追加して、
;; ゲーム盤情報を再び配列に戻す
(board-array (f (coerce board 'list) spare-dice ()))))関数fの引数のアキュムレータaccに渡されるのは、新たなサイコロの追加を考慮された、更新済みのマスのリストである。
fの中では、2箇所でf自身を末尾呼び出ししており、それぞれ、新たなマスの情報をaccにconsしている。
注意点としては、accには左上から右下に向けて走査しつつconsしていっているため、左上の情報はリストの末尾に、右下の情報はリストの先頭にある。
したがって、正しいゲーム盤情報を返すにはaccをreverseする必要がある。
マクロプログラミング によって、プログラマはLispのコンパイラ/インタプリタの動作に変更を加え、Lispを独自の言語へと変化させられる。
例えば、とても簡単な関数を考える。
(defun add (a b)
"2値を加算して、副作用として和をREPLに表示する"
(let ((x (+ a b)))
(format t "The sum is ~a" x)
x))この関数のように、たかだか1つの変数xを宣言するためだけに、多くの括弧が必要となっている場面は多い。
let関数の括弧は、いわゆる 視覚ノイズ の一例である。
この括弧を隠蔽しようと思った時、何か関数を書くことで解決することはできない。
何故なら、letは 特殊形式 と呼ばれるコマンドの1つであるからである。
特殊形式は、言語の根幹に組み込まれており、通常のLisp関数ではできない特別なことができる。
マクロを使えばおの余分な括弧を消すことができる。
ここで、余計な括弧を削除したlet1関数を作ってみる。
(defmacro let1 (var val &body body)
`(let ((,var ,val))
,@body))見て分かる通り、マクロの定義は関数の定義とよく似ている。
ただし、defunの代わりにdefmacroを使う。
関数と同様に、マクロは名前(ここではlet1)と仮引数を持つ。
let1を上の通り定義したら、括弧の少ないletとして次の通り使うことができる。
> (let ((foo (+ 2 3)))
(* foo foo))
25
> (let1 foo (+ 2 3)
(* foo foo))
25Lispのコンパイラ/インタプリタは、「標準のLispコード」しか解釈できない。
したがって、マクロlet1は解釈できない。
ここで、Lispのコンパイラ/インタプリタがマクロを解釈する前に、 マクロ展開 と呼ばれるステップが実施される。
マクロ展開器は、コード中のマクロを探して、それらを標準的なLispコードへど変換する。
したがって、マクロは関数が実行されるのと異なるタイミングで実行されることが分かる。
すなわち、下のとおりである。
- 通常のLisp関数は、その関数を含むプログラムを実行するタイミング(実行時)で解釈される。
- マクロは、プログラムが実行される前、つまり、Lisp環境でプログラムが読み込まれてコンパイルされるタイミング(マクロ展開時)で解釈される。
defmacroによって新たなマクロを定義するということは、つまり、Lispのマクロ展開器に対して、新たな変換ルールを教えるということである。
マクロはもとのソースコードをLispの式の形で、引数として受け取る。
マクロの仕事は、尾野本のコードを標準のLispコードに変換することである。
上で定義したlet1を例に、マクロがどのように変換されるのかを説明する。
let1再掲
(defmacro let1 (var val &body body)
`(let ((,var ,val))
,@body))最初の行は、「let1で始まる行があったらそれを標準的なLispコードに変換するためのルールを定義する」と、マクロ変換器に伝えている。
defmacroは、また、マクロに渡される引数についても定義している。
マクロの引数には、マクロが使われている場所に現れるもとのソースコードが渡される。
let1マクロの場合は、次の3つの引数を受け取ることになる。
> (let1 foo (+ 2 3)
(* foo foo))
25- var
- 最初の引数は、ローカル変数として定義される名前である。 マクロの中では、引数`var`の値がその名前になっている。 上の呼び出しの例では、名前は`foo`である。
- val
- 2番目の式は、ローカル変数の値を決めるコードである。 上の呼び出しの例では、`(+ 2 3)`となっている。
- body
- 3番目の式は、`let1`の中で実行されるコードの本体である。 このコードの中では、`let1`が作る新しい変数(この例では`foo`)を使用できる。 マクロでは、このコードが引数`body`の値として使える。
letコマンドは本体の中に複数の式を書いておけるから、let1も同様に複数の式が書けるようにする。
&bodyはそれを実現するための特別なシンボルである。
&bodyが書かれていると、マクロ展開時に「マクロの使われている場所に出てくる残りの式の全てを、リストにして次の引数に渡せ」という意味になる。
したがって、let1のbody引数に渡ってくる値は、ネストしたリスト((* foo foo))になっているというわけである。
さて、let1マクロの引数については分かった。
次に、マクロがその値を使ってどのようにlet1をletに変換するのかを見ていく。
Lispでソースコードを変換する最も簡単な方法は、バッククォート構文を使用することである。
バッククォートを頭につけた準クォートでは、基本はデータモードで、カンマを付けた部分だけコードモードに戻る。
`(let ((,var ,val))let1マクロは、バッククォートで作られる上のリストを返す。
リストの先頭の要素はシンボルletである。続いて、変数の名前と値が置かれる。
これにより、本来のletコマンドの構文どおりに、ネストされたリストに収まっていることが分かる。
最後に、let1に渡されたbodyのコードが、letコマンドの対応する位置に挿入されている。
ここで、body引数の値を挿入するために、 スプライシングカンマ (,@)を使用している。
スプライシングカンマを使用することで、カンマの対象範囲となるデータの括弧を取り外す(=スプライスする)。
なぜスプライシングが必要なのかは、let1が次のように使われた場合を考えてみると分かりやすい。
(let1 foo (+ 2 3)
(princ "Lisp is awesome!")
(* foo foo))
List is awesome!
25この例では、let1の本体中に複数の式が使われている。
よくよく考えれば分かるが、letコマンドは、暗黙のprognコマンドを含んでいて、本体内に複数のLispコマンドを記載できる。
let1マクロも、body引数の前に特別な&bodyシンボルを置いておいたおかげで同じように複数の式を扱える。
上の例では、bodyの値は((princ "Lisp is awesome!") (* foo foo))となっているため、スプライスすると、letに複数の式を渡したことと同等の結果となるわけである。
let1マクロが書けたので、それを使って本章の最初に書いたadd関数を書き直してみる。
(defun add (a b)
(let1 x (+ a b)
(format t "The sum is ~a" x)
x))また、macroexpandコマンドを使えば、マクロがどのようなコードを作るのか確かめられる。
マクロの呼び出しコードを、次のようにmacroexpandに渡せば良い。
> (macroexpand '(let1 foo (+ 2 3)
(* foo foo)))
(LET ((FOO (+ 2 3))
(* FOO FOO))) ;
T最後のTは、macroexpandが問題なくマクロを展開できたことを表している。
NOTE: マクロが複雑になるにつれ、macroexpandはとても有用なコマンドになる。
ここで、リストの長さを求めるmy-lengthコマンドを考える。
末尾呼び出し最適化が可能な形で実装したものが次の例である。
(defun my-length (lst)
(labels ((f (lst acc)
(if lst
(f (cdr lst) (1+ acc))
acc)))
(f lst 0)))この関数には、特に悪い意味で気になる特徴が2点ある。
- リストをなめていく関数に共通する処理として、次の2つがある
- リストが空かどうかを調べることと
cdrでリストの残りを調べること
- わざわざローカル関数を定義していること
これらの問題を緩和するため、ここからはマクロで対処してみる。
なお、これからの説明は、素朴なマクロ(バグあり)の作成から始めて、段々とブラッシュアップしていく流れになっている。
ここでは、splitマクロを作成する。
my-lengthのような、リストを頭から順に見ていく関数を簡潔に書けるようにする。
リストをなめていく関数は、常に、まずリストが空かどうかをチェックし、空でなければその頭と残りをcarとcdrで取り出して処理をする。
splitマクロは、その共通部分をまとめてやってくれるものである。
まずは、splitマクロの使い方について次に示す。
> (split '(2 3)
(format t "This can be split into ~a and ~a." head tail)
(format t "This can not be split"))
This can be split into 2 and (3).
> (split '()
(format t "This can be split into ~a and ~a." head tail)
(format t "This cannot be split."))
This can not be split.splitマクロの最初の引数は、頭と残りに分解したいリストである。
もし分解可能なら、2番目の引数に渡された式が実行される。
このとき、splitマクロは自動的に2つのローカル変数、headとtailを作り、リストの頭と残りをそれに格納する。
これにより、関数の中でcarとcdrを呼ぶ手間を省ける。
リストが空だったら、3番目の引数に渡された式が実行される。
次に、splitマクロのコードを見てみる。
このコードにはバグがある(後述)。
;; バグあり
(defmacro split (val yes no)
`(if ,val
(let ((head (car ,val))
(tail (cdr ,val)))
,yes)
,no))splitマクロは3つの引数を取る。
すなわち、このマクロを使うときには常に3つの引数を渡す必要がある。
また、リストが空だった場合、noの位置からは変数headとtailは見えないことに注意すること。
splitマクロを使えばmy-length関数は少し綺麗になる。
tail変数を使うことで、コードが簡潔になっているのが分かる。
このマクロのように、自動的に変数を作り出すマクロは、 アナフォリックマクロ と呼ばれる。
NOTE: Anaphoric macro. Anaphoric(前方参照)とは、既に出ている話題に言及する際に代名詞などを使うことである。
ここの例では、分割したリストの頭と残りを、自動的に作られる変数で言及できる。
(defun my-length (lst)
(labels ((f lst acc)
;; lst: リスト
;; acc: アキュムレータ
(split lst
(f tail (1+ acc))
acc)))
(f lst 0)))マクロでよくあるバグとしては、コードを意図せずに複数回実行してしまうことである。
実際に、上のsplitマクロにもこのバグが存在してしまっている。
例えば、次のコードはそのバグを引き起こす。
> (split (progn (princ "Lisp rocks!")
'(2 3))
(format t "This can be split into ~a and ~a." head tail)
(format t "This cannot be split."))
Lisp rocks!Lisp rocks!Lisp rocks!This can be split into 2 and (3).splitを使ったら、"Lisp rocks!"というメッセージが3回も表示されてしまった。
これは、マクロに渡される引数が生のソースコードであることが原因である。
splitマクロの展開時にvalを3回参照するので、princが3回実行されてしまったのである。
実際にマクロがどのように展開されるかは、macroexpandを使えば確かめることができる。
> (macroexpand (split (progn (princ "Lisp rocks!")
'(2 3))
(format t "This can be split into ~a and ~a." head tail)
(format t "This cannot be split.")))
(IF (PROGN (PRINC "Lisp rocks!") '(2 3))
(LET ((HEAD (CAR (PROGN (PRINC "Lisp rocks!") '(2 3))))
(TAIL (CDR (PROGN (PRINC "Lisp rocks!") '(2 3)))))
(FORMAT T "This can be split into ~a and ~a." HEAD TAIL)
(FORMAT T "This cannot be split.")) ;
Tこの問題の解決方法を考えてみると、次のようにローカル変数を使ってみれば良いことに気付く。
(この新しいsplitマクロでは、間に作ったlet1マクロを使ってみている。マクロの中で別のマクロを使うことに問題はない。)
この定義を使用すれば、valの式は1度しか評価されないから、上のようにprincが呼ばれることはない。
NOTE: しかしながら、これにはまだバグがある。
;; 注意! これにもまだバグがある
(defmacro split (val yes no)
`(let1 x ,val
(if x
(let ((head (car x))
(tail (cdr x)))
,yes)
,no)))上のsplitのバグを見るには、次のコードを実行すれば分かる。
> (let1 x 1000
(split '(2 3)
(+ x head)
nil))
*** - +: (2 3) is not a number
> (macroexpand (split '(2 3) (+ x head) nil))
(LET ((X '(2 3)))
(IF X
(LET ((HEAD (CAR X))
(TAIL (CDR X)))
(+ X HEAD))
NIL)) ;
Tこのように、splitのにはxの展開が含まれるが、これがマクロに渡したコードと衝突を起こしてしまっている。
この例では、splitマクロが変数xを意図せず捕捉してしまい、見たい値をシャドウしてしまった。
これによって、splitの外で宣言したxには、最初に1000を代入したにもかかわらず、splitの中でxをシャドウして、
さらにリスト'(2 3)を代入しようとしたために型違いエラーが発生した。
このような変数名の衝突を回避するための素朴な解決策としては、衝突しなさそうなaeicfnuhaceknfのようなおかしな名前の変数を使うというものがある。
これを実現するための仕組みとして、gensym関数がCommon Lispには予め備わっている。
> (gensym)
#:G8695gensym関数が作る名前は、コード中で唯一だと保証される。
また、gensymが返した値と同じ名前をコード中に上書き定義できないようにされており、それが分かるようにプレフィックス(#:)がつけられている。
したがって、gensymを実行してから、その返り値と全く同じ変数名を宣言しても、別々の変数として扱われる。
ここで、gensymを使ってsplitマクロを変数補足に対して安全になるように修正してみる。
;; 安全なバージョン
(defmacro split (val yes no)
(let1 g (gensym) ; マクロ展開時にgにシンボル名を代入
;; マクロ展開時には既にgはシンボル名に評価されている
`(let1 ,g ,val
(if ,g
(let ((head (car ,g))
(tail (cdr ,g)))
,yes)
,no))))
[9]> (macroexpand '(split '(2 3) (+ x head) nil))
(LET ((#:G2985 '(2 3)))
(IF #:G2985
(LET ((HEAD (CAR #:G2985))
(TAIL (CDR #:G2985)))
(+ X HEAD))
NIL)) ;
T
[10]> (macroexpand '(split '(2 3) (+ x head) nil))
(LET ((#:G2986 '(2 3)))
(IF #:G2986
(LET ((HEAD (CAR #:G2986))
(TAIL (CDR #:G2986)))
(+ X HEAD))
NIL)) ;
T
[11]> (macroexpand '(split '(2 3) (+ x head) nil))
(LET ((#:G2987 '(2 3)))
(IF #:G2987
(LET ((HEAD (CAR #:G2987))
(TAIL (CDR #:G2987)))
(+ X HEAD))
NIL)) ;
T上のコードの(let1 g (gensym))部分にバッククォートが無い(=準クォートではない)ことに注意すること。
すなわち、この部分は、 マクロが作り出したコードの実行時 ではなく、 マクロ自身の展開時 に評価される。
また、マクロが展開されるたびに、gensymが異なる変数名を生成していることも分かる。
また、当然だが、変数名が衝突しないことと変数捕捉しないことは同じではない。
このバージョンでもheadとtailという変数を使用しているため、これらの変数を別の意味で使っているコードと混ぜて使用したら、やはり問題は起こる。
しかし、headとtailに関しては、むしろわざと変数を捕捉しているのだ。
アナフォリックマクロでは、マクロ本体内でこれらの変数を使えるようにわざわざ捕捉しているわけであるから、予め決まっている変数を捕捉するのはバグではなく 仕様 である。
ここで、もう一度、my-lengthを修正する。
前に作ったmy-lengthを再掲する。
(defun my-length (lst)
(labels ((f lst acc)
;; lst: リスト
;; acc: アキュムレータ
(split lst
(f tail (1+ acc))
acc)))
(f lst 0)))先述の通り、このコードにもまだ繰り返し出てくるパターンがある。
すなわち、ローカル関数fを定義しているところである。
ここで、再帰部分を隠すrecurseマクロを次に示す。
まず、recurseマクロの使用例を示す。
> (recurse (n 9)
(fresh-line)
(if (zerop n)
(princ "lift-off!")
(progn (princ n)
(self (1- n)))))
9
8
7
6
5
4
3
2
1
lift-off!recurseマクロの最初のパラメータは、変数とその初期値のリストである。
この例では、変数nを宣言し、その初期値を9に設定している。
残りの行は再帰関数の本体を構成する。
再帰関数の本体では、まず、改行している。
次に、nがゼロになったか否かを調べ、ゼロになっていれば"lift-off!"を表示する。
そうでなければ現在のnの値を出力し、自分自身を再帰呼び出しする。
splitマクロと同様、このマクロもアナフォリックである。
すなわち、recurseマクロでは、変数selfで自分自身の関数を参照できる。
再帰の条件が整ったら、selfを呼び出せば良い。
この例では(1- n)を引数として渡して、カウントダウンを実現している。
では、recurseマクロを実装してみる。
まず、変数とその初期値の対を切り出すのに便利なように、補助関数pairs関数を定義する。
pairs関数は末尾呼び出し最適化可能な、リストを舐める関数である。
この関数を定義するためにローカル関数fを定義するはめに陥っているが、後述する方法でこういった関数定義をしなくて良くなる。
この関数fの中では、splitマクロを使ってリストを分解しているが、今回はリストから2つずつ要素を取り出したいため、tailが空でないかを改めて調べている。
これにより、リストが空か、要素が1つしか残っていない((if tail)が偽)場合は、蓄積した値を返す。
そうでなければ最初の2つの要素をペアにしてアキュムレータaccに追加し、再帰する。
> (defun pairs (lst)
;; lst: 2要素ずつコンスセルを作る対象となるリスト
;; acc: 作ったコンスセルを格納するアキュムレータ
(labels ((f (lst acc)
(split lst
(if tail
;; lstが空でなく、かつ、残り部分も空でない場合、
;; => ((head . tail) これまでに作ったコンスセル達)
(f (cdr tail) (cons (cons head (car tail)) acc))
;; lstが空ではないが、残り部分が空の場合、
;; これまでに作ったコンスセル達は逆順なので、順序を正してから返す
(reverse acc))
;; lstが空の場合、
;; これまでに作ったコンスセル達は逆順なので、順序を正してから返す
(reverse acc))))
(f lst nil)))
PAIRS
> (pairs '(a b c d e f))
((A . B) ( C . D) (E . F))次に、いよいよrecurseマクロを定義する。
変数pには、pair関数を使って最初のリストを変数と初期値のコンスセルのリストにしたものを代入する。
次に、selfローカル関数を定義する。
selfの引数は、最初のリストの基数番目の要素(つまりrecurseに渡したvarsのリスト中の変数)を並べたものである。
selfは、マクロ展開された式の中から参照できる(つまりアナフォリックに参照できる)必要があるため、(gensym)を使わず、直接名前を書いている。
そしてマクロの最後で、初期値を引数としてselfを呼び出す。
(defmacro recurse (vars &body body)
;; p: varsで得られた変数とその初期値のコンスセルのリスト
(let1 p (pairs vars)
;; ローカル関数self
;; 引数: varsで得られた変数
;; 関数本体 bodyで得られたリスト(複数可)
`(labels ((self ,(mapcar #'car p)
,@body))
;; ローカル関数selfに初期値を適用
(self ,@(mapcar #'cdr p)))))最後に、recurseマクロを使ってmy-length関数を更に簡潔にする。
my-lengthに必要な補助関数やマクロ定義も全て示す。
(defmacro let1 (var val &body body)
;; 変数を1つだけ代入して式を実行する
;; var: 代入先の変数
;; val: 代入する値
;; body: 実行する式(複数可)
`(let ((,var ,val))
,@body))(defmacro split (val yes no)
;; valに対して頭と残りへの分解を試みる
;; val: 分解対象の式
;; yes: 分解成功時に実行する式
;; no: 分解失敗時に実行する式
(let1 g (gensym) ; マクロ展開時にgにシンボル名を代入
;; マクロ展開時には既にgはシンボル名に評価されている
`(let1 ,g ,val
(if ,g
(let ((head (car ,g))
(tail (cdr ,g)))
,yes)
,no))))(defun pairs (lst)
"2要素ずつコンスセルを作る
lst: 2要素ずつコンスセルを作る対象となるリスト"
;; lst: 2要素ずつコンスセルを作る対象となるリスト
;; acc: 作ったコンスセルを格納するアキュムレータ
(labels ((f (lst acc)
(split lst
(if tail
;; lstが空でなく、かつ、残り部分も空でない場合、
;; => ((head . tail) これまでに作ったコンスセル達)
(f (cdr tail) (cons (cons head (car tail)) acc))
;; lstが空ではないが、残り部分が空の場合、
;; これまでに作ったコンスセル達は逆順なので、順序を正してから返す
(reverse acc))
;; lstが空の場合、
;; これまでに作ったコンスセル達は逆順なので、順序を正してから返す
(reverse acc))))
(f lst nil)))(defmacro recurse (vars &body body)
;; 再帰処理を定義する
;; vars: 変数とその初期値(連続してOK)
;; body: 再帰する処理(再帰呼び出しする関数は変数self)
;; p: varsで得られた変数とその初期値のコンスセルのリスト
(let1 p (pairs vars)
;; ローカル関数self
;; 引数: varsで得られた変数
;; 関数本体 bodyで得られたリスト(複数可)
`(labels ((self ,(mapcar #'car p)
,@body))
;; ローカル関数selfに初期値を適用
(self ,@(mapcar #'cdr p)))))(defun my-length (lst)
"リストの長さを返す
lst: 対象のリスト
ret: リストの長さ"
(recurse (lst lst acc 0)
;; lst: 走査対象のリスト 初期値lst
;; acc: リストの長さ保持用 初期値0
(split lst
;; リストに残りがあれば残りに対して再帰呼び出しする
(self tail (1+ acc))
;; リストが空になったらリストの長さを返す
acc)))マクロはコードを生成するコードを書く手段である。 これにより、Lispはメタプログラミングや新しい言語のアイデアやプロトタイプを作るのに適した言語であるといえる。 しかし、マクロはある意味、小手先のテクニックである。 自作の言語を、標準のLispであるかのようにLispコンパイラ/インタプリタに読み込ませるためのトリックである。 道具立てとしては非常に強力なものだが、エレガントではない。
マクロの一番の欠点は、コードが理解しにくくなることである。 つまり、他のプログラマにとって初見となるプログラミング方言を作っているわけである。 したがって、しばらく後にマクロを駆使したプログラムを読み解くのは非常に骨が折れる作業になる。
初心者Lisperがマクロを書きたくなる場合の多くは、もっとエレガントな解法があるものである。
例えば、my-lengthをマクロを使わずに簡潔に表現する方法は、実は存在する。
次のように、高階関数reduceを使えば良いだけである。
(defun my-length (lst)
(reduce (lambda (x i)
(1+ x))
lst
:initial-value 0))高階関数reduceは、リストの各要素に対して関数適用するための関数である。
reduce関数の第1引数には、縮約を行う関数を渡してやる。
ここではlambdaによって無名関数を作っている。
このlambda関数の第1引数xは、最初に、reduce関数のキーワード引数の:initial-valueの値0を束縛する。
そしてlambda関数本体の処理を行い、その結果をまた次に呼んだlambda関数のxに束縛する。
これにより、リストの各要素に対してlambdaが呼ばれただけxがインクリメントされつつlambdaに渡される。
(すなわちxはアキュムレータである。)
また、縮約関数には、その時に見ているリストの各要素の値も引数に渡されている。
それが引数iである。
ただし、my-length関数ではiを使う必要はない。
このように、高階関数が使える場合はそちらを使った方がくだらないバグに悩まされることもなく、簡単である。 しかし、高階関数が使えない場合もあるから、その場合にマクロを使えるようになっておくことが望ましい。
マクロが最も効果的な場面の一つは、 ドメイン特化言語(DSL) を作る場面である。 DSLプログラミングは高度なマクロプログラミングテクニックの1つで、難しい問題を解くために、Lispの構造をその問題に最適な言語へと大幅に変更するというものである。 DSLプログラミングにマクロが必須というわけではないが、Lispではいくつかのマクロを書くことで簡単にDSLを作ることができる。
例えば、「平均的なプログラム」というものを思い浮かべたとしても、個々のプログラムはその「平均」からは外れている。 すなわち、各プログラムは、特定の問題を解くために作られる。 そして、人が考えを及ぼす領域( ドメイン )には、それぞれ、その領域でこれまでに考え出された様々な枠組みがあり、それが問題を解くプログラムの書き方にも影響を与える。 DSL を使うと、元のプログラミング言語を、ドメイン特有の枠組みに合わせた言語へ拡張できる。
ここからは、特定のドメインを取り上げて、そのドメインでLispを使いやすくするDSLを2つ作ってみる。
作成するDSL
- SVG(scalable vector graphics)ファイルを書き出すためのDSL
- 魔法使いのアドベンチャーゲームのコマンドのためのDSL
SVGフォーマットは、グラフィクスの描画のためのファイルフォーマットである。 円や多角形といったオブジェクトを配置し、コンピュータによってそれを描画する。 SVGフォーマットでは、画像をピクセルではなくベクタによって記述するため、SVGイメージは任意の大きさに拡大縮小して描画できる。
SVGフォーマットはWebブラウザで描画できる。 実際に、SVGフォーマットのファイルをWebブラウザで描画してみる。
<svg xmlns="http://www.w3.org/2000/svg">
<circle cx="50" cy="50" r="50" style="fill:rgb(255,0,0);stroke:rgb(155,0,0)">
</circle>
<circle cx="100" cy="100" r="50" style="fill:rgb(0,0,255);stroke:rgb(0,0,155)">
</circle>
</svg>XMLフォーマットは(HTMLフォーマットと同様に)入れ子になったタグによって構成されている。
開きタグは、それぞれ、閉じタグと対になっている。
閉じタグは、開きタグと同じ名前だが、先頭に/がついている。
また、タグには属性をつけられる。
<mytag color="BLUE" height="9">
<inner_tag>
</inner_tag>
</mytag>マクロを作成していると、マクロの仕事の大部分は関数でこなせると気付く場面が多々ある。 実際、マクロの仕事の殆どは補助関数に任せて、それからマクロを実装する方が良い。 そうすれば、マクロそのものはシンプルに保てる。
ここからは、LispからXML形式のタグを出力するための補助関数を先に作成する。
まず、補助関数print-tagを作成する。
この関数は、1つの開きタグ、または閉じタグを出力する。
(defun print-tag (name alst closingp)
"xmlフォーマットの開きタグ、または、閉じタグを出力する
name: タグ名
alst: 属性名と属性値のコンスセルのリスト
closingp: 閉じタグか否か"
(princ #\<) ; タグの開き角括弧
;; 閉じタグならタグ名の頭に/をつける
(when closingp
(princ #\/))
;; タグ名を小文字に変換する
(princ (string-downcase name))
;; 小文字の属性名と属性値を出力する
(mapc (lambda (att)
(format t " ~a=\"~a\"" (string-downcase (car att)) (cdr att)))
alst)
(princ #\>)) ; タグの閉じ角括弧> (print-tag 'mytag '((color . blue) (height . 9)) nil)
<mytag color="BLUE" height="9">この通り、XMLタグを出力するだけであればこの関数で十分である。
しかし、全てのタグ出力をこのように出力するのは手間がかかる。
そこで、tagマクロを書いて効率化を図る。
これから書くtagマクロは、 Paul Graham によるLisp方言Arcにある同名のマクロを採用したものである。
このマクロでは、print-tagを次の3点において改善する。
どれも、マクロでなければ改善できないものばかりである。
- タグは常に対になっている必要がある。 しかし、タグがネストしていると、1つの関数だけでは閉じタグと開きタグの間に、内側の要素のタグを表記できない。 ネストを考慮しつつタグを対にして表示するには、内側のタグの表示処理の実行前と実行後に外側のタグの表示処理を実行する必要があるが、関数は実行前に引数が全て実行されてしまう。
- タグ名と属性名は動的に変える必要がないため、静的なデータとして持っておいて良い。 すなわち、そのようなデータに対してクオートをつけて呼び出すのは手間である。換言すれば、タグ名はデフォルトでデータモードとして扱われるべきである。
- タグ名と違い、属性値の方は一般的に動的に変えられる。 したがって、ここで作るマクロでは、属性値はコードモードとする。そして、Lispコードを書いておけばその実行結果が属性値として使えるようにする。
これらをまとめると、例えばREPL上でtagマクロを使ったら次のように実行されてほしいわけである。
> (tag mytag (color 'blue height (+ 4 5)))
<mytag color="BLUE" height="9"></mytag>タグ名と属性リストがクオートされていないことに注目すること。 また、属性値にLispコードを書いて計算させていることにも注目すること。
これを実現するtagマクロのコードを次に示す。
(defmacro tag (name atts &body body)
`(progn (print-tag ',name
(list ,@(mapcar (lambda (x)
`(cons ',(car x) ,(cdr x)))
(pairs atts)))
nil)
,@body
(print-tag ',name nil t)))マクロは、まずprint-tagを呼んで開きタグを生成する。
この部分は、属性のalistを作成する必要があり、しかも属性の部分はコードモードにする必要があるため、少々複雑なコードとなっている。
まず、属性リスト属性名と属性値の組をpairs関数(前章で作成した)で切り出し、それに対してmapcarを適用して、print-tag関数に渡す属性リストを生成している。
属性名の方はクオートし、属性値の方は式のままとしている。
tagマクロの残りの引数に渡されたコードを開きタグの次に実行するようにして、最後に閉じタグを出力している。
ネストしたタグの例を次に示す。 みやすさを考慮して改行とインデントを入れている。
> (tag mytag (color 'blue size 'big)
(tag first_inner_tag ())
(tag second_inner_tag ()))
<mytag color="BLUE" height="9">
<first_inner_tag>
</first_inner_tag>
<second_inner_tag>
</second_inner_tag>
</mytag>当然だが、tagマクロはXMLにもHTLにも使える。
例えば、"Hello World"を表示するHTMLドキュメントを生成するコードは次のとおりである。
> (tag html ()
(tag body ()
(princ "Hello World!")))
<html><body>Hello World!</body></html>HTMLはXMLと異なり、使えるタグ名が既に定まっている。 したがって、それぞれのHTMLタグを出力する簡易マクロを定義しておけば、LispからHTMLを生成するのが更に簡単になる。
(defmacro html (&body body)
`(tag html ()
,@body))
(defmacro body (&body body)
`(tag body ()
,@body))> (html
(body
(princ "Hello World!)))
<html><body>Hello World!</body></html>ここからは、DSLをSVGのドメインに向けて拡張していく。
まず、SVGの画像全体を囲むsvgマクロを書いてみる。
(defmacro svg (width height &body body)
`(tag svg (xmlns "http://www.w3.org/2000/svg"
"xmlns:xlink"
"http://www.w3.org/1999/xlink"
height ,height width ,width)
,@body))SVGイメージには、次の2つの属性を用意する。
- 1つ目の属性・・・
xmlns属性。SVGビューワ(例えばWebブラウザ)がSVGフォーマットのための適切なドキュメントを参照できるようにする。 - 2つ目の属性・・・画像の中にハイパーリンクを置けるようにする。
画像を描くためには色を扱えなければならない。
簡単のために、色はRGBのリストとして表現することとする。
つまり、(255 0 0)は真っ赤な色を表す。
特定の色を基準に、より明るい色やより暗い色が必要になる場合がある。
そういった場合のために、brightness関数を定義する。
(defun brightness (col amt)
(mapcar (lambda (x)
(min 255 (max 0 (+ x amt))))
col))明るい赤をこの関数に渡し、輝度調整値amtに-100を渡せば、暗い赤が返される。
> (brightness '(255 0 0) -100)
(155 0 0)次に、SVGの描画要素のスタイルを生成する関数を実装する。
(defun svg-style (color)
"表面の色と、枠線の色のスタイルを出力する
スタイルは、枠線の色=表面の色-100"
(format nil
"~{fill:rgb(~a,~a,~a);stroke:rgb(~a,~a,~a)~}"
(append color (brightness color -100))))次に、円を描く関数を実装する。
(defun circle (center radius color)
"円を描画する
center: 円の中心の座標(コンスセル)
radius: 円の半径
color: 円の色(r,g,b)"
(tag circle (cx (car center)
cy (car center)
r radius
style (svg-style color))))> (svg 150 150
(circle '(50 . 50) 50 '(255 0 0))
(circle '(100 . 100) 50 '(0 0 255)))
<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" height="150" width="150">
<circle cx="50" cy="50" r="50" style="fill:rgb(255,0,0);stroke:rgb(155,0,0)"></circle>
<circle cx="100" cy="100" r="50" style="fill:rgb(0,0,255);stroke:rgb(0,0,155)"></circle>
</svg>これで、基本的なSVG DSLは作成できた。 ここからは、機能をどんどん追加していく。
SVG DSLに、任意の多角形(ポリゴン)を描く関数を追加する。
SVGのポリゴンは頂点座標をpoints属性に格納する。
頂点のリストは、format関数の~{~}制御文字列を使って生成している。
11章の「format関数でテキストを表示する」で見たように、この制御文字列は引数に渡されたリストをループする。
ここでは頂点をループするためにまず、座標値のペアのリストをmapcanによってネストのないリストへと スプライス している。
すなわち、mapcan=mapcar+appendである。
(defun polygon (points color)
(tag polygon (points (format nil
"~{~a,~a ~}"
(mapcan (lambda (tp)
(list (car tp) (cdr tp)))
points))
style (svg-style color))))次の例は、 ランダムウォーク を表現する関数である。 ランダムウォークとは、1歩進む度に方向をランダムに変えながら歩く軌跡を表すグラフである。 横方向は右に一定に進み、上下のみランダムにすれば、株価変動のようなグラフが表現できる。 実際に、金融市場のモデルの初期値として使用されることもある。
(defun random-walk (value length)
"1次元のランダムウォークの軌跡をリストで返す
value: 初期値
length: ランダムウォークの長さ
ret: ランダムウォークの軌跡のリスト"
(unless (zerop length)
(cons value
(random-walk (if (zerop (random 2))
(1- value)
(1+ value))
(1- length)))))実行結果は次のとおりである。
> (random-walk 100 10)
(100 101 100 99 100 101 102 101 102 101)では、SVG DSLを使って、いくつかのランダムウォークをSVG画像として表示してみる。
;; ランダムウォークを描画したSVGファイルを作成する
(with-open-file (*standard-output* "random-walk.svg"
:direction :output
:if-exists :supersede)
;; svg画像を描画する
;; 横: 400
;; 縦: 200
;; 描画対象: 上辺がランダムウォークの多角形10個
;; 色: ランダム
(svg 400 200 (loop repeat 10
do (polygon (append
;; 左下の頂点
'((0 . 200))
;; 左上から右上までの頂点
(loop for x
for y in (random-walk 100 400)
collect (cons x y))
;; 右下の頂点
'((400 . 200)))
;; 多角形の色
(loop repeat 3
collect (random 256))))))ここまでで、Lispによって簡単にXML,HTML,SVGのためのDSLが書けることが分かった。 これらのDSLは、どれも、Lispのリスト構造そのものを、見た目を表現するためのマークアップ言語に変換するものだった。
次の章では、全く別の種類のDSLを作成する。
この章では、ゲームにありがちな問題を解決するためのDSLを実装する。 つまり、特定のアイテム、特定の場所、それらの組み合わせによって、特別なコマンドが起動できるようにする。
コマンドの実現方針としては、次のとおりである。
- ゲームとして共通の部分は、何度も記述したくない
- 特定のアイテムに特有の処理については、Lispで直接コーディングしたい
これらを実現するためのDSLについて、ここから学んでいく。 まずは、魔法使いのアドベンチャーゲームをREPLにロードしておくこと。 さもなければ本章のコードは実行できない。
NOTE: game-replコマンドと使って直接コマンドを入力できること、および、game-replから抜けるにはquitコマンドを使うように実装したことを思い出すこと。
;; ゲームの実行例
> (load "AdventureGame.lisp")
;; Loading file AdventureGame.lisp ...
;; Loaded file AdventureGame.lisp
T
> (game-repl)
You are in the living-room. Awizard is snoring loudly on the couch. .......
quitゲームDSLは、結局の所どのようにあるべきか。 それを知るために、まずはいくつかのコマンドを直接LSIPで書いてみることにする。 その後、異なるコマンドの間に存在する 共通パターン を見つけ出して、それを基礎としてDSLを作成することにする。
魔法使いの屋敷の屋根裏には、溶接機がある。
プレイヤーが鎖とバケツを屋根裏に持っていき、バケツに鎖を溶接できる(weld)ようにしてみる。
まず、プレイヤーが特定のアイテムを持っているか否かを調べやすくするため、have関数を定義している。
プレイヤーの持ち物全てを返すinventoryコマンドの返り値に引数のアイテムが含まれていれば、プレイヤーはそのアイテムを持っていることになる。
(defun have (object)
(member object (cdr (inventory))))次に、鎖とバケツが溶接されているかどうかという情報を保持する必要がある。
ゲームにおいて、これらのアイテムが溶接されているときのみ可能なアクションがあるかもしれない。
この目的のためにグローバル変数*chain-welded*を用意する。
(defparameter *chain-welded* nil)最後に、溶接(weld)コマンドを定義している。
溶接は、次の条件を全て満たす時に可能となる。
- プレイヤーが屋根裏にいる
weldコマンドでは、「バケツを」「鎖に」溶接する、というアクションのみを処理する- プレイヤーは、既に鎖とバケツを持っている必要がある
- 鎖とバケツはまだ溶接されていない状態である必要がある
(defun weld (subject object)
(if (and (eq *location* 'attic)
(eq subject 'chain)
(eq object 'bucket)
(have 'chain)
(have 'bucket)
(not *chain-welded*))
(progn (setf *chain-welded* t)
'(the chain is now securely welded to the bucket.))
'(you cannot weld like that.)))game-replには、予め登録されているコマンドのみ実行可能にしている。
したがって、weldコマンドを使用するために、許可コマンドリストにweldを追加する必要がある。
pushnewコマンドを使うことで、weldがまだ許可コマンドリストに追加されていない場合にのみpushされるようになる。
> (pushnew 'weld *allowed-commands*)
(WELD LOOK WALK PICKUP INVENTORY)
> (game-repl)
weld chain bucket
You cannot weld like that.魔法使いの野屋敷の庭には井戸がある。 プレイヤーがバケツを投げ入れて(dunk)、水を汲めるようにする。
weldと同様に、まずバケツに水が入っているかどうかを覚えておく変数を用意する。
(defparameter *bucket-filled* nil)次に、dunk関数を定義する。
weld同様に、dunkにも「投げ入れる」動作をしても良いか判断するための条件式がある。
(defun dunk (subject object)
(if (and (eq *location* 'garden)
(eq subject 'bucket)
(eq object 'well)
(have 'bucket)
*chain-welded*)
(progn (setf *bucket-filled* t)
'(the bucket is now full of water))
'(You cannot dunk like that.)))最後に、dunk関数を許可コマンドリストに追加する。
(pushnew 'dunk *allowed-commands*)先述のweldコマンドとdunkコマンドを実装したことで、これらに似た処理の部分があることが分かった。
また、それぞれのコマンドには、コマンド固有の処理というものが存在することも分かった。
これらを上手くまとめ上げるために、game-actionマクロを作成する。
(defmacro game-action (command subj obj place &body body)
;; ゲームアクションを定義するマクロ
;; command: コマンド名
;; subj: コマンド実行に必要な主体
;; obj: コマンド実行に必要な客体
;; place: コマンド実行に適した場所
;; body: コマンド処理本体
`(progn
;; コマンド定義
(defun ,command (subject object)
;; コマンド実行可能条件
(if (and (eq *location* ',place) ; 有効な場所
(eq subject ',subj) ; 有効な主体
(eq object ',obj) ; 有効な客体
(have ',subj)) ; 主体を持っている
;; コマンド実行
,@body
;; コマンド実行不可時のメッセージ
'(i cant ,command like that.)))
;; 許可コマンドリストに定義したコマンドを追加
(pushnew ',command *allowed-commands*)))game-actionマクロの主な仕事は、コマンドを実現する新たな関数を定義することである。
このように、マクロはその中で関数定義することも可能である。
このマクロの中では、場所、主体となるアイテムの有無、客体となるアイテムの有無、主体を持っているか否かのチェック機構を入れている。 しかし、それ以外の条件は、コマンドごとに本体の中でチェックするようにしている。
共通部分の条件が満たされたら、追加のチェックは各コマンドのロジックの中で書くようにする。
共通部分の条件が満たされなかったら、「コマンド実行不可時のメッセージ」を返す。
最後にpushnewを使って、作成したコマンドをgame-replの「許可コマンドリスト」に追加する。
このマクロで実装していないのは、状態を管理するグローバル変数を定義したり変数したりする処理である。
すなわち、*chain-welded*や*bucket-filled*といった変数を作るなら、マクロとは別に実装する必要がある。
何故別々に実装するようにするのか。
理由は、特定のコマンドと、特定の状態を管理する変数が1対1対応するとは限らないからである。
コマンドによっては、状態を持たずに実行できるものもあるだろうし、反対に、複数の状態に依存するものもあるだろう。
このマクロによって、新しいゲームアクションを作るための簡単なDSLが完成した。 すなわち、このコマンドによって、ゲームコマンドのドメインに特化した新たなプログラミング言語が作り出されたということになる。
weldとdunkを、このDSLを使って書き直してみる。
(defparameter *chain-weided* nil)
(game-action weld chain bucket attic
(if (and (have 'bucket) (not *chain-welded*))
(progn (setf *chain-welded* 't)
'(the chain is now securely welded to the bucket.))
'(you do not have a bucket.)))
(defparameter *bucket-filled* nil)
(game-action dunk bucket well garden
(if *chain-welded*
(progn (setf *bucket-filled* 't)
'(the bucket is now full of water))
'(the water level is too low to reach.)))見て分かる通り、各コマンドのロジックが簡潔に表されている。
weldはバケツを持っていることをチェックしているが、dunkではwellをチェックする必要はないことが分かりやすい。
マクロでゲームコマンドDSLを作る利点をもっと示すために、より複雑なコマンドを実装してみる。 次に示すコマンドは、状況によって3つの異なる結果を返す。
- バケツが空の場合、特に何も起こらない。(メッセージ:バケツは空だ)
- バケツが一杯で既にカエルを取っていた場合、プレイヤーの負けとなる。
- バケツが一杯でカエルを取っていなかった場合、プレイヤーの勝利となる。
(game-action splash bucket wizard living-room
(cond ((not *bucket-filled*) '(the bucket has nothing in it.))
((have 'frog) '(the wizard awakens and sees that you stole his frog.
he is so upset he banishes you to the netherworlds- you lose! the end.))
(t '(the wizard awakens from his slumber and greets you warmly.
he hands you the magic low-carb donut- you win! the end.))))game-actionマクロを使えば、それぞれの特徴的なゲームアクションコマンドをたくさん作成できる。
しかも、似たようなコードを繰り返し書く手間を省ける。
NOTE:
game-actionコマンドは、捜査の対象となるアイテムを束縛した変数subjectとobjectをマクロのボディ中で使えるようにする。
ゲームコマンドはこれらの変数で情報にアクセスできるようになるが、game-actionコマンドを作り出すコードがsubjectやobjectという名前の変数を既に使用している場合は、名前衝突を起こす。
安全を期すなら、gensymコマンドを用いたマクロに書き直したほうが良い。
関数型プログラミングによって、コードが簡潔になることが分かった。 数学的な関数は、同じ引数に対して常に同じ結果を返すことによる利点である。
しかし、15章で関数型プログラミングによってゲームを造ったとき、問題点も明らかになった。 すなわち、引数のみに依存して関数の値を計算しようとすると、引数に 膨大 な情報量を渡す羽目になる。
ダイスオブドゥームでは、ゲーム盤でこれから起き得る全ての状態を表したgame-tree引数を渡していた。
この引数は、たった3x3のゲーム盤でさえ巨大な構造となっていた。
このときの設計は、コードを簡単でエレガントにしてはいたものの、より大きなゲーム盤に対して容易にはスケールしてくれない。
なぜなら、ゲーム木はゲーム盤が大きくなるにつれて指数関数的に大きくなるからである。
幸いにも、コードの現在のエレガントさを保ったまま(関数型プログラミングのまま)、より大きなゲーム盤で複雑なゲームを実現する方法は存在する。 すなわち、ゲームの最初から全ての可能性を見なくて済むように、 遅延評価 という機能を使う。 この章では、遅延評価を使ってダイスオブドゥームを改善する。
遅延評価を使っても、コード上ではゲームの初期化時にゲーム木を作ってしまうことに変わりはない。 ただし、ゲーム木の一部以外は、本物の枝を作る時にやっていたような実際の計算を行わない。 すなわち、実際にゲーム木のその箇所を評価する必要ができてからはじめて計算するのである。 プレーヤーがゲーム中のある手を指さず、AIもその手を考慮しなかったとしたら、プログラムはその枝から先がどうなっているかを計算しなくても良いのである。
計算の必要が出てきてからはじめて計算する部分を、遅延評価における 遅延部分 と呼ぶ。
HaskellやClojureといった言語では、遅延評価が言語のコアでサポートされている。 むしろ、Clojureでは遅延評価が推奨されている。 しかし、残念なことにCommon Lispには遅延評価やそれに類する機能がサポートされていない。 そこで、Common Lispのマクロ機能を使用することで、自分で遅延評価の機能を実現することとする。
遅延評価の機能を実現するために、lazyコマンドとforceコマンドを作成する。
まず、lazyコマンドは、コードを包むことでLispにそのコードの評価を後回しにするように指示する。
lazyの使用例を次に示す。
見て分かる通り、lazyコマンドで包まれたコードは関数としてまとめられる。
> (lazy ( + 1 2))
#<FUNCTION ...>次に、forceコマンドは、先程のlazyコマンドによってまとめられた関数を実行する。
forceの使用例を次に示す。
> (force (lazy (+ 1 2)))
3ここで重要な点は、「実際の計算が、遅延された値が作られたときではなく、その結果が要求された時にはじめて行われた」という事実である。 これを実感するため、より複雑な例を示す。
> (defun add (a b)
(princ "I am adding now")
(+ a b))
ADD
> (defparameter *foo* (lazy (add 1 2)))
*FOO*
> (force *foo*)
I am adding now
3この例では、2個の数を足すadd関数を定義した。
この関数は、評価されるときに副作用としてコンソールにメッセージを表示する。
コンソールにメッセージが表示されているタイミングが、forceを呼び出したときであることから、addの計算が実際にこの部分でなされたことが分かる。
lazyの簡単な実装は次のとおりである。
lazyはマクロによって実現している。
(defmacro lazy (&body body)
(let ((forced (gensym))
(value (gensym)))
`(let ((,forced nil)
(,value nil))
(lambda ()
(unless ,forced
(setf ,value (progn ,@body))
(setf ,forced t))
,value))))マクロは生成されたコード中で変数を2つ使用するため、gensymを使って変数の名前を作り出している。
次に来るのが、マクロが実際に生成するコード本体である(行頭にバッククォートがついている行)。
コード本体の行頭では、gensymによって作られた変数名を使って、ローカル変数を2つ生成している(,forcedと,value)。
最初の変数,forcedは、遅延した値が既に評価されたかどうかのフラグである。
これがnilであれば、値はまだ評価されていない。
これがtなら、すでに評価済みである。
次の変数,valueは、評価された関数の戻り値を格納する変数である。
このマクロによって生成されたlambdaは、クロージャの仕組みを使って,forced変数と,value変数を捕捉している。
さらに、このlambdaは、マクロの引数に渡された式をそのまま中に取り込んでいる。
これによって、lambdaは、次の2種類の情報を持っている。
- クロージャによって呼び出されたか否かといった情報を持つ
lazy呼び出し時に渡された式を内部にすべて持つ
ここで、forceコマンドによってlambdaが計算されると、次のとおり動作する。
,forcedがnil(まだ計算されていない場合)nilで初期化しておいた,valueに計算結果を格納する,forcedをtに更新する
,forcedがt(すでに計算されている場合),valueの値を返す(lambdaは一切評価しない)
次にforceマクロを実装する。
lazyマクロのようなトリッキーな実装ではなく、forceは非常に素朴な実装である。
単純に、引数に渡された関数を呼び出すだけである。
(defun force (lazy-value)
(funcall lazy-value))先程作ったコマンドを基にして、 遅延リスト のライブラリを作ることにする。 この遅延リストライブラリはClojureのものを参考にしている(Clojureでは遅延リストを 遅延シーケンス と呼ぶ)。
Lispにおいてリストを扱う最も基本的なコマンドはconsである。
したがって、遅延リストではlazy-consコマンドから作成する。
このマクロはconsと似ているが、結果をlazyマクロで包んで返す。
ついでに、lazy-carとlazy-cdrも作っておくことにする。
(defmacro lazy-cons (a b)
`(lazy (cons ,a ,b)))
(defun lazy-car (x)
(car (force x)))
(defun lazy-cdr (x)
(cdr (force x)))これらの使用例を次に示す。
実行結果から分かるように、lazy-consとlazy-carとlazy-cdrは、それぞれ、consとcarとcdrと同じように使用できる。
> (defparameter *foo* (lazy-cons 4 7))
*FOO*
> (lazy-car *foo*)
4
> (lazy-cdr *foo*)
7これらの単純な関数で、次のような有用な定義を実現できる。
すなわち、全ての正整数のリスト*integers*を定義しているのである。
無限長のリストを定義しているにも関わらず、遅延評価を導入したことで全ての評価をしてシステムダウンするような自体を回避できている。
(defparameter *integers*
(labels ((f (n)
(lazy-cons n (f (1+ n)))))
(f 1)))実際にこれを評価すると次のとおりになる。
> (lazy-car *integers*)
1
> (lazy-car (lazy-cdr *integers*))
2
> (lazy-car (lazy-cdr (lazy-cdr *integers*)))
3マクロを展開すると、次のとおりになる。
(lazy-car (lazy-cdr (lazy-cdr *integers*)))
; =>
(lazy-car
(lazy-cdr
(lazy-cdr
(labels ((f (n)
(lazy-cons n (f (1+ n)))))
(f 1)))))
; =>
(car
(force
(cdr
(force
(cdr
(force
(labels ((f (n)
(lazy
(cons n (f (1+ n))))))
(f 1))))))))lazy-コマンドを使っている限り、この正整数のリスト*integers*から、欲しいだけ正整数を取り出すことができる。
取り出したいところまでの整数が、必要に応じて計算されるのである。
このような無限長のリストばかりが遅延リストではない。 すなわち、終端を持つ遅延リストも存在する。
終端を持つ遅延リストを実現するためには、lazy-nilコマンドも必要となる。
そして、通常のリストに対して、終端に達したかどうかを調べるnull関数に対応する、遅延リストの終端を調べるlazy-null関数も必要となる。
(defun lazy-nil ()
"forceされるとnilを返す"
(lazy nil))(defun lazy-null (x)
"遅延リストがnilならtを返す"
(not (force x)))ここからは、遅延リストの操作に便利な関数を作っていく。
まず必要となるのは、通常のリストを遅延リストに変換する関数である。
これを実現するmake-lazy関数を実装する。
(defun make-lazy (lst)
(lazy (when lst
(cons (car lst) (make-lazy (cdr lst))))))このmake-lazy関数は、大雑把に言えば、再帰で与えられたリストを順に見ていき、それぞれのコンスをlazyなマクロで包んでいるということになる。
しかしながら、この関数の実際の意味を正しく理解するには、lazyとforceの意味を考える必要がある。
幸いなことに、遅延リストライブラリを完成させてしまえば、これらの遅延評価にまつわる奇妙さはライブラリの中に隠されることとなる。
make-lazy関数は普通のリストを遅延リストに変換した。
では反対に、遅延リストを普通のリストに変換するためのtakeおよびtake-all関数を実装する。
(defun take (n lst)
"遅延リストから指定した数の要素だけ取り出す"
(unless (or (zerop n) (lazy-null lst))
(cons (lazy-car lst)
(take (1- n) (lazy-cdr lst)))))(defun take-all (lst)
"遅延リストから全ての要素を取り出す
無限長の遅延リストには使用禁止"
(unless (lazy-null lst)
(cons (lazy-car lst) (take-all (lazy-cdr lst)))))これらを使用すると、次のようになる。
> (take 10 *integers*)
(1 2 3 4 5 6 7 8 9 10)
> (take 10 (make-lazy '(q w e r t y u i o p a s d f)))
(Q W E R T Y U I O P)
> (take-all (make-lazy '(q w e r t y u i o p a s d f)))
(Q W E R T Y U I O P A S D F)遅延リストに対して、マップや検索を実現する関数を次に示す。
mapcar、mapcan、find-if、nthに対する遅延リスト版の関数を実装する。
これらの関数は、引数に遅延リストを取り、戻り値もリストを返す場合は遅延リストを返す。
これらの関数の実装には、lazy-null、lazy-car、lazy-cdrを使う必要がある。
(defun lazy-mapcar (fun lst)
(lazy (unless (lazy-null lst)
(cons (funcall fun (lazy-car lst))
(lazy-mapcar fun (lazy-cdr lst))))))(defun lazy-mapcan (fun lst)
(labels ((f (lst-cur)
(if (lazy-null lst-cur)
(force (lazy-mapcan fun (lazy-cdr lst)))
(cons (lazy-car lst-cur) (lazy (f (lazy-cdr lst-cur)))))))
(lazy (unless (lazy-null lst)
(f (funcall fun (lazy-car lst)))))))(defun lazy-find-if (fun lst)
(unless (lazy-null lst)
(let ((x (lazy-null lst)))
(if (funcall fun x)
x
(lazy-find-if fun (lazy-cdr lst))))))(defun lazy-nth (n lst)
(if (zerop n)
(lazy-car lst)
(lazy-nth (1- n) (lazy-cdr lst))))上の関数の使い方は、次のとおりである。
> (take 10 (lazy-mapcar #'sqrt *integers*))
(1 1.4143135 1.7320508 2 2.236068 2.4494898 2.6457512 2.828427 3 3.1622777)lazy-mapcarを使って無限長の正整数リストにsqrtをマップすると、全ての正整数の平方根の遅延リストが得られる。
> (take 10 (lazy-mapcan (lambda (x)
(if (evenp x)
(make-lazy (list x))
(lazy-nil)))
*integers*))
(2 4 6 8 10 12 14 16 18 20)lazy-mapcanを使って、各正整数について、それが偶数ならその数だけからなる遅延リストを、それが奇数なら遅延空リストを返す関数を適用している。
ここでは、結果として、無限正整数リストから偶数だけを取り出したリストを、要素10個分だけ返している。
> (lazy-find-if #'oddp (make-lazy '(2 4 6 7 8 10)))
7find-ifを使って、遅延リストから最初の奇数を探している。
この例では、結果として7を返している。
> (lazy-nth 4 (make-lazy '(a b c d e f g)))
Elazy-nthを使って、遅延リストの指定箇所の要素を取り出している。
これら、遅延リスト版の関数を、例えばlazy.lispファイルに記載しておき、このファイルをロードしていつでも使えるようにしておくと良い。
15章で作成したダイスオブドゥームVer1に、遅延リストライブラリを適用する。 まず、ダイスオブドゥームのコードと、遅延リストライブラリをロードする。
> (load "dice_of_doom_v1.lisp")
> (load "lazy-lisp")ロードしたコードに変更を加えることで、ゲームを遅延リスト版に変更する。
次に、ゲーム盤の大きさを4x4に拡大する。
> (defparameter *board-size* 4)
> (defparameter *board-hexnum* (* *board-size* *board-size*))この大きさのゲームを実用的な速度で実行するには、ゲーム木のそれぞれの枝を遅延リストとして表現する必要がある。 そのためには、バージョン1のゲームのいくつかの関数を遅延リスト関数を使ったものに差し替える必要がある。
まず、与えられたゲーム盤の状態に対して、攻撃と手番終了の手を計算する関数を変更する。
add-passing-move関数では、1箇所だけ変更する。
手のリストを遅延リストにするため、可能な手のリストに手番を終える手を加えるのにlazy-consを使う。
(defun add-passing-move (board player spare-dice first-move moves)
(if first-move
moves
(lazy-cons (list nil
(game-tree (add-new-dice board player
(1- spare-dice))
(mod (1+ player) *num-players*)
0
t))
moves)))attacking-moves関数では、多めの変更が必要である。
まず、遅延リストを返すために、手のリストを組み立てる2箇所のmapcanをlazy-mapcanに置き換える。
lazy-mapcan関数はその中で作るリストも遅延リストでなければならないので、make-lazy関数を使うようにする。
また、nilを返していたところはlazy-nilを返すようにする。
最後に、計算されたゲーム盤のリストも遅延リストにする。
このリストは外側のlazy-mapcanに使われる。
(defun attacking-moves (board cur-player spare-dice)
(labels ((player (pos)
(car (aref board pos)))
(dice (pos)
(cadr (aref board pos))))
(lazy-mapcan
(lambda (src)
(if (eq (player src) cur-player)
(lazy-mapcan
(lambda (dst)
(if (and (not (eq (player dst)
cur-player))
(> (dice src) (dice dst)))
(make-lazy
(list (list (list src dst)
(game-tree (board-attack board
cur-player
src
dst
(dice src))
cur-player
(+ spare-dice (dice dst))
nil))))
(lazy-nil)))
(make-lazy (neighbors src)))
(lazy-nil)))
(make-lazy (loop for n below *board-hexnum*
collect n)))))次に、人間のプレイヤーに対応する2つの関数に変更を加える。
handle-human関数では、ローカル関数print-movesを定義している。
これは可能な手のリストを舐めていく関数である。
- リスト終端のチェック
- リストの先頭からの手を取り出す
- リストの残りの部分で再帰する
上の3箇所について、遅延版のコマンドを使うように変更する。
さらに、プレイヤーが選んだ手を可能な手のリストから取り出すところにlazy-nthを使うようにする。
(defun handle-human (tree)
(fresh-line)
(princ "choose your move:")
(let ((moves (caddr tree)))
(labels ((print-moves (moves n)
(unless (lazy-null moves)
(let* ((move (lazy-car moves))
(action (car move)))
(fresh-line)
(format t "~a. " n)
(if action
(format t "~a -> ~a" (car action) (cadr action))
(princ "end turn")))
(print-moves (lazy-cdr moves) (1+ n)))))
(print-moves moves 1))
(fresh-line)
(cadr (lazy-nth (1- (read)) moves))))paly-vs-human関数では、変更は1箇所だけである。
ゲームの終了状態に達したかどうかを判断するのに、可能な手のリストが空かどうかを調べ、もし空なら勝者を計算する。
この、リストが空かどうかを調べる箇所を、lazy-nullに置き換える。
(defun play-vs-human (tree)
(print-info tree)
(if (not (lazy-null (caddr tree)))
(play-vs-human (handle-human tree))
(announce-winner (cadr tree))))ここまでの変更で、より大きな盤面を使ったダイスオブドゥームを人間対人間で遊べるようになった。 すなわち、ゲーム技はプレイヤーがその状態を選んだ場合にしか計算されない。 4x4のゲーム盤でゲームを開始するには、バージョン1と同様に、次のコマンドを入力すれば良い。
> (play-vs-human (game-tree (gen-board) 0 0 t))
current player = a
a-1 a-3 a-1 b-2
b-3 a-3 a-3 a-1
a-3 a-3 b-1 a-2
b-3 a-3 a-1 a-3
choose your move:
1. 5 -> 10
2. 6 -> 10
3. 9 -> 10
4. 11 -> 10
5. 15 -> 10ここでは、ゲームAIの関数を遅延リストライブラリに対応させる。 また、ついでにAIコードにいくつかの改善をする。
ダイスオブドゥームver1のAIコードは、ある意味では最強だった。 というのも、手を決める全ての機会に、AIは 将来起こりうる全ての状態 を調べて、その中で最良手を指していたからである。
しかし、この方法は、ゲーム盤の規模が少し大きくなるだけで計算量が爆発して破綻する。 そもそも、ゲーム木に遅延評価を入れた目的は、全ての枝を計算対象にしたくないからであった。
したがって、このバージョンにおいては、ゲームAIには「最大でも何手までしか計算しなくて良い」と指示できる仕組みが必要となる。
関数型プログラミングスタイルを使ったダイスオブドゥームでは、この変更は非常に簡潔に記述できるが、すぐには思いつかないような方法である。 そこで、ステップバイステップで考えることとする。
すぐに思いつく方法としては、バージョン1のget-ratingとrate-positionを変更して、search-depthという新しいアキュムレータを引数に足すことである。
そして、これらの関数を呼び出す度に、先読みの最大値に達したかどうかを調べる。
でもこの方法には問題がある。 それぞれの関数が余分な引数を背負わされて、本来の関数の処理が分かりにくくなってしまっている。 本来、盤面の状態を評価することと、なんて先まで読むかを判断することは、別々の関心事のはずである。 つまり、これらの関心事は直行している、といえる。 したがって、各々の処理は別々の関数で扱われるべきである。
ここで、先程の遅延ゲーム木を使うと、探索木を「刈り込む」という仕事だけをする関数を、可能な手を評価して次の手を考えるAIコードとは完全に独立して記述できる。
ゲーム木を刈り込む関数を次に示す。
この関数は、引数を2つだけ取る、かなり簡単な関数である。
返り値は、新しく作られるゲーム木のコピーである。
コピーの枝は、この関数を再帰的に呼んで作成されるが、再帰する度にdepthをデクリメントする。
depthが0になったら、そこか刈り込む深さであるから、可能な指し手に対応する遅延ゲーム木を空にする。
(defun limit-tree-depth (tree depth)
"ゲーム木を指定の深さで刈り込む
tree: 遅延ゲーム木
depth: 何手先まで読むか(何手先で枝を刈るか)
ret: 新しく作られる遅延ゲーム木のコピー"
(list (car tree) ; プレイヤーID
(cadr tree) ; ゲーム盤情報
;; 刈り込む深さになったら、指し手の遅延リスト部分を空にする
;; 刈り込む深さでなかったら、可能な指し手に対応する遅延ゲーム木を取得する
(if (zerop depth)
(lazy-nil) ; 空のゲーム木
(lazy-mapcar (lambda (move)
;; 指定された指し手に対応する遅延ゲーム木を取得する
;; move: 指し手をキーに持つ遅延ゲーム木のalist
;; ret: 指し手に対応する遅延ゲーム木
(list (car move) ; 指し手
(limit-tree-depth (cadr move) (1- depth)))) ; 指し手に対応するゲーム盤情報
;; 指し手をキーに持つ遅延ゲーム木のalistのリスト
(caddr tree)))))他に必要となるのは、ゲームAIが手を評価する直前にこのlimit-tree-depthを呼んでやることだけである。
hadle-computer関数を少し変更すれば実現できる。
すなわち、get-ratingsを呼んで現在の木から先の手を評価する前に、現在の木を刈り込む。
すると、元のゲーム木の全容をゲームAIは意識しない。
さらに細かな変更として、評価後の手を遅延リストから選び出すためにlazy-nthを使用するようにした。
;;; ゲームAIが先読みする遅延ゲーム木の深さ
(defparameter *ai-level* 4)
(defun handle-computer (tree)
"ゲームAIを操作する
tree: 現在の遅延ゲーム木
ret: ゲームAIの指し手に対応する遅延ゲーム木"
;; ratings: 現在のゲーム盤情報における、各指し手に対する点数のリスト
(let ((ratings (get-ratings (limit-tree-depth tree *ai-level*)
(car tree))))
;; 最高得点を得られる指し手を計算し、それに対応する遅延ゲーム木を返す
(cadr (lazy-nth (position (apply #'max ratings) ratings)
(caddr tree)))))さらに、play-vs-computerにも1箇所変更がある。
可能な指し手の遅延リストが空であるか確かめるためにlazy-nullを使うように変更する。
(defun play-vs-computer (tree)
"対コンピュータ戦を開始する
tree: 遅延ゲーム木
ret: "
;; ゲーム情報を表示する
(print-info tree)
;; 指し手をキーとする遅延ゲーム木のalistが空なら、現在のゲーム盤情報から勝者を表示してゲーム終了
;; プレイヤーIDが0(人間の手番)なら、人間から指し手を要求してゲーム続行する
// プレイヤーIDがゲームAIの手番なら、ゲームAIに指し手を計算させてゲーム続行する
(cond ((lazy-null (caddr tree)) (announce-winner (cadr tree)))
((zerop (car tree)) (play-vs-computer (handle-human tree)))
(t (play-vs-computer (handle-computer tree)))))ここでは、AIを強化する方法について考える。
ゲーム木を刈り込む事により、ゲームAIについて本質的に変化が生じた。 すなわち、刈り込みがなければ完璧なプレイを見せたゲームAIは、いまや、勝てる指し手を「見逃す」可能性を生じるようになった。 これは、性能と引き換えに、完璧な手を指すことを捨てたといえる。
このような状況は、ヒューリスティクスな状況であるといえる。 コンピュータサイエンスにおけるヒューリスティクスは、完全ではないが及第点以上の良い結果を素早く得られるようなプログラミングテクニックを意味する。 ダイスオブドゥームにおいても、簡単なチューニングを実施することで、ゲームAIの性能を大幅に引き上げることができる。
ゲーム木の全ての枝について勝敗を評価する場合、ゲームAIはどのくらい差をつけて勝つかを気にする必要はなかった。 つまり、ゲームの終了時点で、相手より1つでも多くのマスを確保していれば勝ちであった。
しかし、今のゲームAIはヒューリスティックなアルゴリズムとなった。 すなわち、ゲームの任意の時点において、どの程度相手をリードしているのかはとても重要な勝因となる。
ここで有効な経験則としては、「今、相手を十分に引き離していれば、たとえ数手先しか読まなくとも相手に追いつかれる確率は低い」というものがある。
このゲームのゲームAIに実装したミニマックスアルゴリズムでは、ゲーム木の「葉」にそれぞれスコアをつけていた。 まず、バージョン1(全ての枝を確認するVer.)では、このスコアは0(AIの負け)、1(AIの勝ち)、1/2(引き分け)という単純なものであった。
しかし、バージョン2においては、評価関数が見ることのできる範囲でのゲーム木の「葉」は、本当のゲームの勝敗を決するものではなく、その先に刈られた枝が続いている。 この場合、スコアの範囲を拡大して、どの手を指すと「より大きく」勝ち、どの手を指すと「より小さく」勝つのかということを判断できるようにしたい。
もっと複雑なヒューリスティクスを使用して、葉の部分のゲーム盤の状態を評価するscore-boardを記述してみる。
score-board関数は、ゲーム盤の全てのマスをループして、loopマクロのsumを使って各マスのスコアを合計する。
プレイヤーが現在のマスを占領していれば正のスコアを加算する。
下記のルールで各マスのスコアを算出する。
- プレイヤーが所有するマスで、より強い敵のマスが隣にない:2
- プレイヤーが所有するマスで、より強い敵のマスが隣にある:1
- 敵が所有するマス:-1
NOTE score-boardはヒューリスティックな関数であって、スコアの付け方に絶対的な正解は無い。
(defun score-board (board player)
"指定のプレイヤーにとっての現在のゲーム盤情報のスコアを算出する
board: ゲーム盤情報
player: プレイヤーID
ret: ゲーム盤情報のスコア"
;; ゲーム盤を走査しながら、各マスのスコアを合計する
(loop for hex across board
for pos from 0
;; 下記のルールで各マスのスコアを算出する
;; - プレイヤーが所有するマスで、より強い敵のマスが隣にない:2
;; - プレイヤーが所有するマスで、より強い敵のマスが隣にある:1
;; - 敵が所有するマス:-1
sum (if (eq (car hex) player)
(if (threatened pos board)
1
2)
-1)))上のscore-board関数で使われているthreatened関数を次に示す。
この関数では、引数で指定したマスの隣を走査して、敵が所有している、かつ、サイコロが引数のマスよりも多いマスが無いかを調べる。
(defun threatened (pos board)
"隣のマスにより強い敵のマスがあるか判定する
pos: ゲーム盤の位置
board: ゲーム盤情報
ret: t:隣により強い敵のマスがある nil:ない"
(let* ((hex (aref board pos)) ; 引数posで指定したマス情報
(player (car hex)) ; マスを所有するプレイヤーのID
(dice (cadr hex))) ; マスに置かれたサイコロの数
(loop for n in (neighbors pos)
do (let* ((nhex (aref board n)) ; posの隣のマス情報
(nplayer (car nhex)) ; posの隣のマスを所有するプレイヤーのID
(ndice (cadr nhex))) ; posの隣のマスに置かれたサイコロの数
;; posの隣のマスが、異なる所有者でより多くのサイコロを持っていたら、
;; 隣のマスにより強い敵のマスがあると評価する
(when (and (not (eq player nplayer)) (> ndice dice))
(return n))))))次に、上のscore-boardとthreatenedを使って、get-ratingsとrate-positionを改良してみる。
大きな改良点としては、これ以上続く指し手のないゲーム木に対して、得点をつけていることである。
(defun get-ratings (tree player)
"現在の遅延ゲーム木における指定したプレイヤーが取りうる得点を全パターン返す
tree: 遅延ゲーム木
player: 得点を算出したいプレイヤーのID
ret: 得点のリスト"
(take-all (lazy-mapcar (lambda (move)
;; 指し手に対応するそのマスの得点を計算する
(rate-position (cadr move) player))
;; 可能な全ての指し手
(caddr tree))))(defun rate-position (tree player)
"現在のゲーム木から指定プレイヤーの得点を算出する
tree: 遅延ゲーム木
player: プレイヤーID
ret: 得点"
(let ((moves (caddr tree))) ; 可能な指し手
;; 現在のゲーム木に可能な指し手があれば、次に取りうる全てのゲーム木を見ていき、
;; ミニマックスアルゴリズムを適用したときの得点を返す
;; 現在のゲーム木に可能な指し手がなければ、現在のゲーム盤の得点を返す
(if (not (lazy-null moves))
(apply (if (eq (car tree) player)
#'max
#'min)
(get-ratings tree player))
(score-board (cadr tree) player))))これで、ヒューリスティクスを用いたゲームAIが大きな盤面で動かせる。 以前の例と同様に、プレイヤーBの指してはAIアルゴリズムで自動的に計算されたものとなる。
> (play-vs-computer (game-tree (gen-board) 0 0 t))
...
...
...アルファ・ベータ法 はミニマックスアルゴリズムにおける、よく知られた最適化手法である。 最終的なミニマックス評価の結果に影響を及ぼさないと判断した枝を飛ばしてしまう(枝刈りする)ことで処理速度を上げるのである。
ゲーム木のとある枝が最終的な評価に影響を及ぼさないというのはどういう場合か。
アルファ・ベータ法を理解するため、2x2のゲーム盤でのゲーム木を示した図を見てみる。
図の意味
- ゲームは図の一番上からスタートする
- 矢印が可能な手を表す
- 各四角には、どちらが手番化を示してある
- 各ゲーム盤の右下の数字が、(
score-board関数を使った)最新のget-ratingsによる評価値- 葉ノードでは、評価値は
score-boardにより直接計算される - 葉ノード以外では、数値はミニマックスアルゴリズムにより選ばれる
- 葉ノードでは、評価値は
- ゲーム木の各状態の中で、指し手を選ぶ余地のあるノード(分岐のあるノード)はMAXノード、または、MINと示してある
- プレイヤーAが選べる分岐はMAXノード
- プレイヤーBが選べる分岐はMINノード
ミニマックスアルゴリズムは、深さ優先探索である。
つまり、ゲーム木を左から右に、深さ優先で、全ての葉を調べていく。
(ここでは、*ai-level*が高く設定されていて、木が一切刈り込まれていないとしよう。)
全ての葉を見た後、分岐があるノードについて、最小または最大のスコアを採用する。
ここで、MINの分岐に注目する。
ミニマックスアルゴリズムを適用すると、MINノードの最初(左側)のぶん機のスコアは8であることが分かる。
AIエンジンが右側の枝を見に行く際には、スコアが8以下になることだけが重要である。
8とそれより大きい数から最小を取れば常に8であるから、8より大きな数は結果に影響しない。
したがって、AIが左の分岐でスコア8を見つけたら、その時点でもうそれ以上右側の枝を調べる必要がない事がわかる。 つまり、ミニマックスアルゴリズムにおいては、図中の点線で示されている部分の枝を調べる必要はないということである。
この例においては、枝刈りできた部分はごく一部分のみであったが、ゲーム木の規模が大きくなれば、大抵は大部分の枝を刈り取ることができる。
巷でよく見られるアルファ・ベータ法においては、alphaとbetaという変数を利用する。
つまり、MINノードかMAXノードかによって、alphaとbetaの役割(上限か下限か)を適宜入れ替えて使うことで、同じコードを両方の種類のノードに使えるようにする。
しかし、ここで作成するコードでは、わかりやすさを優先して、upper-limitとlower-limitという変数を受け渡していくことにする。
これらは、それぞれ、ゲーム木を調べている最中に気にすべき上限値と下限値を表す。
alphaとbetaを使わないことで、MINとMAXそれぞれの場合分けのコードに重複が生じるが、上限値と下限値を明確にしておくことで、アルファ・ベータ法のコードをより平易にする意味がある。
もう一つの注意として、ここでは、ミニマックスアルゴリズムのコード部分と、アルファ・ベータ法のコード部分を分離しない。
先程のダイスオブドゥームにおける「先読み制限」のコードでは、先読みを制限するlimit-tree-depth関数をAIコードの残りの部分と独立して実践した。
アルファ・ベータ法も同様に、ゲーム木を変換する独立した関数として実装できなくはない。
しかし、アルファ・ベータ法のコードはミニマックスの計算の中間結果を参照しなければならないので、少しややこしくなる。
もっと進んだAIエンジンなら、それでも分離しておくのが良い設計となるが、この規模のゲームであれば、アルファ・ベータ法のチェックもミニマックスアルゴリズムのコード中に入れてしまっても良いであろう。
ここからは、実装に入る。
まず、get-ratings関数を、ab-get-ratings-max関数とab-get-ratings-min関数で置き換える。
get-ratings関数は、与えられたゲーム盤の状態から、可能な指し手のうち最良のものを計算する関数であった。
そして、これから実装したいのは、「評価関数が「これ以上の指しては存在しない」と判断したら直ちに評価を打ち切る処理」である。
打ち切りの決定ロジックは、今見ているノードがMAX(自分のプレイヤーの手番)か、MIN(相手プレイヤーの手番)かによって異なる。
まず、MAXノードについて計算する関数ab-get-ratings-maxを実装する。
この関数は引数としてget-ratings関数が受け取っていた引数に加え、upper-limitとlower-limitを受け取る。
この関数自身は最大値だけに関心があるため、lower-limitは参照しない。
ただし、子ノードにMINノードがあれば、再帰呼出しの先では最小値を求める必要がある。
したがって、再帰呼び出し先のために下限を引数に持つ。
(defun ab-get-ratings-max (tree player upper-limit lower-limit)
"MAXノードにおいて、現在のゲーム盤で取りうるスコアの最大値を計算する
tree: 現在の遅延ゲーム木
player: プレイヤーID
upper-limit: スコアの上限
lower-limit: スコアの下限
ret: スコアの最大値"
(labels ((f (moves lower-limit)
;; 可能な指し手の中からスコアの最大値を求める
;; moves: 可能な指し手
;; lower-limit: 探索すべきスコアの下限
;; ret: スコアの最大値
;; 可能な指し手があれば、それらに対してスコアの最大値を計算する
(unless (lazy-null moves)
;; x: 未探索の指し手のうち一番左側の指し手のスコアを計算する
(let ((x (ab-rate-position (cadr (lazy-car moves))
player
upper-limit
lower-limit)))
;; - xが上限以上なら、それ以上探索する必要はないので評価を打ち切る
;; - xがそれ以外なら、残りの枝をさらに探索する必要がある
;; - xがそれまでのlower-limitより大きければxを新たなlower-limitとして採用する
(if (>= x upper-limit)
(list x)
(cons x (f (lazy-cdr moves) (max x lower-limit))))))))
;; 可能な指し手と下限を指定して、スコアの最大値を計算する
(f (caddr tree) lower-limit)))次に、MINノードについて計算する関数ab-get-ratings-minを実装する。
この関数は引数としてget-ratings関数が受け取っていた引数に加え、upper-limitとlower-limitを受け取る。
この関数自身は最小値だけに関心があるため、upper-limitは参照しない。
ただし、子ノードにMAXノードがあれば、再帰呼出しの先では最大値を求める必要がある。
したがって、再帰呼び出し先のために上限を引数に持つ。
(defun ab-get-ratings-min (tree player upper-limit lower-limit)
"MINノードにおいて、現在のゲーム盤で取りうるスコアの最小値を計算する
tree: 現在の遅延ゲーム木
player: プレイヤーID
upper-limit: スコアの上限
lower-limit: スコアの下限
ret: スコアの最大値"
(labels ((f (moves upper-limit)
;; 可能な指し手の中からスコアの最大値を求める
;; moves: 可能な指し手
;; upper-limit: 探索すべきスコアの上限
;; ret: スコアの最大値
;; 可能な指し手があれば、それらに対してスコアの最大値を計算する
(unless (lazy-null moves)
;; x: 未探索の指し手のうち一番左側の指し手のスコアを計算する
(let ((x (ab-rate-position (cadr (lazy-car moves))
player
upper-limit
lower-limit)))
;; - xが下限以下なら、それ以上探索する必要はないので評価を打ち切る
;; - xがそれ以外なら、残りの枝をさらに探索する必要がある
;; - xがそれまでのupper-limitより大きければxを新たなupper-limitとして採用する
(if (<= x lower-limit)
(list x)
(cons x (f (lazy-cdr moves) (min x upper-limit))))))))
;; 可能な指し手と上限を指定して、スコアの最小値を計算する
(f (caddr tree) upper-limit)))新たな関数ab-rate-positionでは、まず現在のノードが自分の手番化相手の手番化を確認する。
自分の手番であればMAXノードということであるから、処理をab-get-ratings-maxに任せる。
相手の手番であればMINノードということであるから、処理をab-get-ratings-minに任せる。
その他の部分は以前のrate-positionと同じである。
(defun ab-rate-position (tree player upper-limit lower-limit)
""
(let ((moves (caddr tree)))
(if (not (lazy-null moves))
(if (eq (car tree) player)
(apply #'max (ab-get-ratings-max tree
player
upper-limit
lower-limit))
(apply #'min (ab-get-ratings-min tree
player
upper-limit
lower-limit)))
(score-board (cadr tree) player))))最後に、ミニマックスアルゴリズムを起動するhandle-computer関数を、新しい関数を呼ぶように変更する。
この関数は、ab-get-ratings-maxを呼び出すことでミニマックスアルゴリズムを起動する。
この関数が呼ばれるのは、自分の手番なわけだから、最初に評価されるノードはMAXノードである。
(defun handle-computer (tree)
(let ((ratings (ab-get-ratings-max (limit-tree-depth tree *ai-level*)
(car tree)
most-positive-fixnum
most-negative-fixnum)))
(cadr (lazy-nth (position (apply #'max ratings) ratings) (caddr tree)))))この関数を呼び出すにあたって、upper-limitとlower-limitの初期値を決めてやらないとならない。
ミニマックスアルゴリズムをこれから開始するわけであるから、上限および上限はできる限り無限に近づけておきたい。
多くのLisp環境では無限大が定義されているが、ANSI Common Lispには無限大が含まれていない。
ただし、規格としては、most-positive-fixnumとmost-negative-fixnumを定めていて、これらはとても大きな絶対値を持つ正負の数である。
今回の目的としてはこれで十分であるため、これらの値をab-get-ratings-maxに渡している。
AIエンジンの効率をもう少し上げたいなら、upper-limitとlower-limitをscore-boardが返しうる最大値と最小値にしておくことも考えられる。
そうすれば、多少は枝刈りできる機会が増えるであろう。
しかし、score-boardが返す値の範囲はゲーム盤の大きさに依存しており、将来、点数計算を更に最適化したら変化するリスクを持つ。
したがって、今のところは初期値には安全なものを採用することとする。
ここまでの最適化を完了させたところで、ゲーム盤の大きさを5x5に拡張してみる。 ここまでで、下の最適化を実装したAIアルゴリズムであれば、この大きさのゲーム盤でも難なく処理できるであろう。
- 遅延評価
- 先読み制限
- 枝刈り
5x5ゲーム盤でゲーム開始
(defparameter *board-size* 5)
(defparameter *board-hexnum* (* *board-size* *board-size*))18章で作ったダイスオブドゥームVer2では、Ver1よりも大きなゲーム盤でプレイ可能となった。
この規模だと、コンソールでの可視化には視認性に限界がある。
そこで、この章では、ダイスオブドゥームにグラフィックをつけ、クリックして手が指せるように改造する。
13章でWebサーバを作成し、17章ではDSLを使ってSVGを描画した。 これらを組み合わせれば、ブラウザ上でグラフィック表示を簡単に実現できる。
HTML5の規格では、SVG画像をHTMLドキュメント内に埋め込むことができるから、これを利用する方針とする。
NOTE ここからは、18章で作成したdice of doom version.2と、13章で作成したwebserverと、16,17章で作成したSVGレンダリングライブラリを使用する。
まず、ゲーム盤の各部の大きさを決める定数を定義する。
ボードの幅と高さは900x500とする。
*board-scale*は1つの升の幅の半分の長さをピクセル数で表したものである。
*top-offset*は、盤の上に3マス分の空白を開けることを表す。
*dice-scale*は、1つのサイコロの大きさ(幅、高さ)を指定する。
*dot-size*はサイコロの目の点の大きさで、ここではサイコロ自体の大きさの0.05倍としている。
(defparameter *board-width* 900) ; ゲーム盤の横幅(pixel)
(defparameter *board-height* 500) ; ゲーム盤の高さ(pixel)
(defparameter *board-scale* 64) ; 1つのマスの幅の半分の長さ(pixel)
(defparameter *top-offset* 3) ; ゲーム盤の上にあける空白の大きさ(何マス分か)
(defparameter *dice-scale* 40) ; 1つのサイコロの大きさ(pixel)
(defparameter *dot-size* 0.05) ; サイコロの目の大きさ(サイコロ自体の何倍か)サイコロを描くコードを示す。ここでは、サイコロを、SVGを使って全てコードとして記載する。
(defun draw-die-svg (x y col)
"指定した座標にサイコロを1つ描画する
x: サイコロを描画するx座標(pixel)
y: サイコロを描画するy座標(pixel)
col: サイコロの色(RGB値)
ret: -"
(labels ((calc-pt (pt)
;; 描画対象の座標を補正する
;; pt: 補正する前の座標コンスセル
;; ret: 補正した後の座標コンスセル
(cons (+ x (* *dice-scale* (car pt)))
(+ y (* *dice-scale* (cdr pt)))))
(f (pol col)
;; 指定した頂点座標と色情報をもとにポリゴンを描画する
;; pol: ポリゴンの頂点座標
;; col: ポリゴンの色情報(RGB値)
;; ret: ポリゴンのsvg記述
(polygon (mapcar #'calc-pt pol) col)))
;; サイコロの上面を描画する
(f '((0 . -1) (-0.6 . -0.75) (0 . -0.5) (0.6 . -0.75))
(brightness col 40))
;; サイコロの左面を描画する
(f '((0 . -0.5) (-0.6 . -0.75) (-0.6 . 0) (0 . 0.25))
col)
;; サイコロの右面を描画する
(f '((0 . -0.5) (0.6 . -0.75) (0.6 . 0) (0 . 0.25))
(brightness col -40))
;; サイコロの目を描画する(サイコロ1つの3面分を一気に)
(mapc (lambda (x y)
(polygon (mapcar
(lambda (xx yy)
;; サイコロの目を描画する
(calc-pt (cons (+ x (* xx *dot-size*))
(+ y (* yy *dot-size*)))))
;; サイコロの目のx座標とy座標
'(-1 -1 1 1)
'(-1 1 1 -1))
;; サイコロの目の色(白)
'(255 255 255)))
;; サイコロの目のx座標とy座標
'(-0.05 0.125 0.3 -0.3 -0.125 0.05 0.2 0.2 0.45 0.45 -0.45 -0.2)
'(-0.875 -0.80 -0.725 -0.775 -0.70 -0.625 -0.35 -0.05 -0.45 -0.15 -0.45 -0.05))))では、x=50, y=50の位置に、RGB値(255 0 0)(赤)のサイコロを描く。
> (svg 100 100 (draw-die-svg 50 50 '(255 0 0)))
; サイコロ1つ分のSVGコードが表示される次に、6角マスとその上に積み上がったサイコロを描く関数を書こう。
(defun draw-tile-svg (x y pos hex xx yy col chosen-tile)
"六角形のマスとその上に積み上がったサイコロを描く
x: マスのx座標(マス目)
y: マスのy座標(マス目)
pos: 描画対象のマス
hex: プレイヤーIDとサイコロ数のコンスセル
xx: マスの描画用x座標(pixel)
yy: マスの描画用y座標(pixel)
col: マスとサイコロの色
chosen-tile: 選択中のマスの番号
ret: -"
;; マスを描く(厚みを持たせるため、縦をずらして2重に描く)
(loop for z below 2
do (polygon (mapcar (lambda (pt)
(cons (+ xx (* *board-scale* (car pt)))
(+ yy (* *board-scale* (+ (cdr pt) (* (- 1 z) 0.1))))))
;; 六角形のマスの座標(上から時計回り)
'((-1 . -0.2) (0 . -0.5) (1 . -0.2) (1 . 0.2) (0 . 0.5) (-1 . 0.2)))
;; 選択中のマスを明るくする
(if (eql pos chosen-tile)
(brightness col 100)
col)))
;; サイコロを描く
(loop for z below (second hex)
do (draw-die-svg (+ xx
(* *dice-scale*
0.3
;; サイコロを左右にブレさせる
(if (oddp (+ x y z))
-0.3
0.3)))
(- yy (* *dice-scale* z 0.8))
col)))では、1マス分のタイルを描く。
> (svg 300 300 (draw-tile-svg 0 0 0 '(0 3) 100 150 '(255 0 0) nil))
; サイコロ3つが載ったタイル1つ分のSVGコードが表示されるゲーム盤全体をSVG画像として描く。
;; サイコロの色(赤と青)
(defparameter *die-colors* '((255 63 63) (63 63 255)))SVGには、webリンクを埋め込むことができる。
これは、通常のHTMLにおける<a href="...">によるハイパーリンクと同様に動作する。
プレイヤーが次に選択できるマスについて、そのマスのSVGをリンクで囲んでやることにより、マスがクリック可能になる。
ゲーム盤は、斜めから見下ろした形で描画するため、真上からみた形の座標を変換している。
また、奥に行くにつれてマスを暗くすることにより、奥行きを出している。
(defun draw-board-svg (board chosen-tile legal-tiles)
"ゲーム盤をsvg記述する
board: ゲーム盤情報
chosen-tile: 選択中のマス
legal-tiles: プレイヤーが次に選択可能なマスのリスト
ret: -"
;; ゲーム盤の全マスを走査する
(loop for y below *board-size*
do (loop for x below *board-size*
;; 現在のマスの番号
for pos = (+ x (* *board-size* y))
;; 現在のマスの情報(プレイヤーIDとサイコロ数)
for hex = (aref board pos)
;; 現在のマスの表示座標(x座標)
for xx = (* *board-scale* (+ (* 2 x) (- *board-size* y)))
;; 現在のマスの表示座標(y座標)
for yy = (* *board-scale* (+ (* y 0.7) *top-offset*))
;; マスとサイコロの色(上の行ほど暗く補正する)
for col = (brightness (nth (first hex) *die-colors*)
(* -15 (- *board-size* y)))
;; 現在のマスが、プレイヤーが次に選択可能なマス、または、選択中のマスの場合、
;; リンクで囲ってクリック可能にする
;; 現在のマスが、それ以外の場合、そのまま選択される
do (if (or (member pos legal-tiles) (eql pos chosen-tile))
;; リンクの場合は1マス分を<g>タグで囲んでグルーピングする
(tag g ()
(tag a ("xlink:href" (make-game-link pos))
(draw-tile-svg x y pos hex xx yy col chosen-tile)))
(draw-tile-svg x y pos hex xx yy col chosen-tile)))))make-game-linkは、適切なURLを作って返す関数である。
(defun make-game-link (pos)
"リンクするURLを生成する
pos: リンク対象のマスの番号
ret: -"
(format nil "/game.html?chosen=~a" pos))下記を実行した結果をファイルに保存してwebブラウザで表示すると、ゲーム盤が表示される。
> (svg *board-width* *board-height* (draw-board-svg (gen-board) nil nil))
; ゲーム盤のSVGコードが表示されるwebサーバの中心となる関数は、dod-request-handlerである。
この関数は、先に作ったwebブラウザからくる全てのリクエストを処理する役割を持つ。
次に示すのが、dod-request-handlerのコードである。
;; 現在のゲーム木
(defparameter *cur-game-tree* nil)
(defparameter *from-tile* nil)(defun dod-request-handler (path header params)
"Webブラウザから来る全てのリクエストを処理する
path: URL
header: *未使用*
params: URLのパラメータ
ret: -"
;; アクセスされたURLがgame.htmlならゲーム処理する
(if (equal path "game.html")
;; doctypeを指定して、html5だと認識させる
(progn (princ "<!doctype html>")
(tag center ()
(princ "Welcome to DICE OF DOOM!")
(tag br ())
(let ((chosen (assoc 'chosen params)))
;; どのマスも選択されていないか、ゲーム木が空なら、
;; ゲームを初期化する
(when (or (not *cur-game-tree*) (not chosen))
(setf chosen nil)
(web-initialize))
;; ゲーム木における可能な手が空なら、ゲームを終了させる
;; 人間のプレイヤーの手番なら、パラメータから指し手を取得し、htmlを組み立てる
;; ゲームAIの手番なら、ゲームAIに指し手を選ばせ、htmlを組み立てる
(cond ((lazy-null (caddr *cur-game-tree*))
(web-announce-winner (cadr *cur-game-tree*)))
((zerop (car *cur-game-tree*))
(web-handle-human
(when chosen
(read-from-string (cdr chosen)))))
(t (web-handle-computer))))
(tag br ())
;; ゲーム盤を描く
(draw-dod-page *cur-game-tree* *from-tile*)))
(princ "Sorry... I don't know that page.")))dod-request-handlerでは、まず、リクエストされたページがgame.htmlであるかどうかをチェックする。
このページが、webサーバ上でゲームを置いておくことにするページである。
ページの先頭では、まずdoctypeを指定する。
これにより、webブラウザは返されたページがHTML5であると認識する。
その後、オープニングメッセージを画面中央に表示するHTMLを出力する。
このwebサーバには、制限が存在する。
まず、処理を簡単にするため、dod-request-handlerは誰からのwebリクエストが来たのかを一切チェックしていない。
したがって、複数のプレイヤーが別々のゲームを同時にプレイしようとしたら、dod-request-handlerは正常に動作しない。
マルチユーザ対応したいのであれば、セッション情報をキーとするハッシュテーブルに、グローバル変数の情報を格納してしまうことにより、ユーザごとのゲーム木を保持させることができる。
dod-request-handlerのもう一つの制限は、URLからの情報を読むためにread-from-string関数を使っていることである。
この関数は、悪意のあるLispプログラマであれば、簡単に任意コードを実行されてしまう。
したがって、このサーバをインターネット上に公開するのは強く非推奨である。
新規にダイスオブドゥームを始めるために、ゲームエンジンを初期化するweb-initializeのコードを次に示す。
dod-request-handlerでは、paramを見て、ゲーム木が空、あるいは、どのマスも選択されていない場合、web-initialize関数を呼んでゲームを新規で開始する。
(defun web-initialize ()
"ゲームエンジンを初期化する
ret: -"
;; ランダムなゲーム盤を作成して保持する
(setf *from-tile* nil)
(setf *cur-game-tree* (game-tree (gen-board) 0 0 t)))webブラウザに勝者を表示する関数を示す。
(defun web-announce-winner (board)
"勝者を表示する"
(fresh-line)
(let ((w (winners board)))
(if (> (length w) 1)
(format t "The game is a tie between ~a" (mapcar #'player-letter w))
(format t "The winner is ~a" (player-letter (car w)))))
(tag a (href "game.html")
(princ " play again")))web-handle-humanは、人間のプレイヤーの手番である場合のHTMLページの作成を行う。
(defun web-handle-human (pos)
"人間のプレイヤーを処理する
pos: 選択したマスの番号"
(cond
;; マスを未選択:
;; 攻撃元のマス選択メッセージを表示
((not pos) (princ "Please choose a hex to move from:"))
;; パスを選択済み:
;; プレイヤーの補給が完了したとメッセージを表示
;; パラメータにnilを渡すcontinueリンクを表示
((eq pos 'pass) (setf *cur-game-tree*
(cadr (lazy-car (caddr *cur-game-tree*))))
(princ "Your reinforcements have been placed.")
(tag a (href (make-game-link nil))
(princ "continue")))
;; マスを選択済み & 攻撃元のタイルがセットされていない:
;; 今選ばれたマスを攻撃元としてセット
((not *from-tile*) (setf *from-tile* pos)
(princ "Now choose a destination:"))
;; 今選択したマスが攻撃元のタイルと同じ:
;; 攻撃元のタイルをリセット
((eq pos *from-tile*) (setf *from-tile* nil)
(princ "Move cancelled."))
;; 上記以外(=攻撃元と攻撃先を選択完了した):
;; 攻撃元と攻撃先に対応するゲーム木に遷移する
;; 次の手を指すかパスするかを選ばせる
(t (setf *cur-game-tree*
(cadr (lazy-find-if (lambda (move)
(equal (car move)
(list *from-tile* pos)))
(caddr *cur-game-tree*))))
(setf *from-tile* nil)
(princ "You may now ")
(tag a (href (make-game-link 'pass))
(princ "pass"))
(princ " or make another move:"))))web-handle-computerは、ゲームAIプレイヤーの手番である場合のHTMLページの作成を行う。
(defun web-handle-computer ()
"ゲームAIプレイヤーを処理する"
;; ゲームAIにゲーム木を遷移させる
(setf *cur-game-tree* (handle-computer *cur-game-tree*))
(princ "The computer has moved. ")
;; webブラウザを5秒毎にリロードさせる
;; これによりリロードしたときにはコンピュータの手番とさせるために、chosen=NILとしている
(tag script ()
(princ "window.setTimeout('window.location=\"game.html?chosen=NIL\"',5000)")))draw-dod-page関数は、ゲームサーバとSVG生成コードとをつなぎ、現在のゲーム盤を描く。
(defun draw-dod-page (tree selected-tile)
"HTMLの中にSVGゲーム盤を描く
tree: ゲーム木
selected-tile: タイルを選択中か"
(svg *board-width* ; ゲーム盤の幅
*board-height* ; ゲーム盤の高さ
(draw-board-svg (cadr tree)
selected-tile
;; プレイヤーが選択可能なマスのリストを計算する
(take-all (if selected-tile
;; 攻撃元のタイルを選択中なら、
;; 有効な攻撃先を全て収集する
(lazy-mapcar
(lambda (move)
(when (eql (caar move)
selected-tile)
(cadar move)))
(caddr tree))
;; 攻撃元のタイルを選択していなかったら、
;; 有効な攻撃から、攻撃元を収集する
(lazy-mapcar #'caar (caddr tree)))))))サーバ側で下記のコマンドを叩くことでゲームを起動できる。
> (serve #'dod-request-handler)次に、クライアント側のwebブラウザでゲームページにアクセスする。
ダイスオブドゥームのバージョン4を作る。
今までのバージョンでは、プログラムを簡単にするため、重要なルールを省略していた。
本章では、ゲームのプレイヤーを増やし、サイコロを振るようにし、さらにいくつかの改良をダイスオブドゥームに施す。
まず、前章で作ったコードをファイルに保存し、呼び出すだけで使用できるようにしておく。
> (load "dice_of_doom_v3.lisp")最初の変更では、プレイヤーを2人から4人に増やす。
うち3人は、ゲームAIプレイヤーである。
まず、変数*num-players*の値を4にし、新たなプレイヤーのためのサイコロの色を追加する。
(defparameter *num-players* 4)
(defparameter *die-colors* '((255 63 63) ; 赤
(63 63 255) ; 青
(63 255 63) ; 緑
(255 63 255))) ; 紫プレイヤーの数の定数を変更したため、他の定数も変えておく。
サイコロの最大数を5個に増やし、そしてAIのレベルを4から2に減らした。
ゲームAIが3人もいるため、対人としては賢さがそれほど必要ではなくなったわけである。
(defparameter *max-dice* 5) ; サイコロの最大数
(defparameter *ai-level* 2) ; AIが思考するゲーム木の深さこれまで作ってきたゲームAIプレイヤーは、いわゆる「パラノイド戦略」をとっている。
すなわち、それぞれのAIプレイヤーは「他のプレイヤーはすべて敵で、他人を攻撃することしか眼中にない」と考えている。
これは必ずしも悪い戦略ではないが、プレイヤーが3人以上になると、他の有効な戦略も存在することは覚えておきたい。
例えば、負けているプレイヤー同士が結託して、トップのプレイヤーを攻撃する、などである。
しかしながら、本書のAIエンジンは、そういった協力プレイは一切計算できない。
これまでのゲームにおける重大な欠陥の1つは、サイコロを一切振っていない点である。 これはつまりサイコロのランダム性を全く使っていないということである。
このバージョンにおいては、攻撃にあたって、攻撃元のマスのサイコロ、攻撃先のサイコロ、それぞれをまとめて振り、目の合計の多いほうが勝つ。 目が同じだった場合は、防御側の勝ちとする。 攻撃側が失敗した場合は、攻撃側のマスはサイコロを1つだけ残して、残りを防御側のプレイヤーに渡すルールとする。
上記のルールを実現するためには、AIプログラミング用語でいう確率ノード(chance node)をゲーム木に足す必要がある。
次に、実装を示す。
今まで、ゲーム木の次の手を表す遅延リストの要素は、下記の2つの項目を持つリストであった。
- car: 手の記述(攻撃の場合は、攻撃元と攻撃先のマス。手番終了)
- cadr: 手が選ばれた場合の、次のゲーム木のノード
ここに、3つ目の項目として、攻撃が失敗した場合のゲーム木のノードを追加する。
すなわち、ゲーム木のそれぞれの手から伸びる枝が、攻撃の成否によってさらに2つに分岐することになる。
では、attacking-moves関数を拡張し、それぞれの手が確率ノードとして動作するように要素を付け足していく。
ここでの変更における新しい変更は、ゲーム木に新たな手を付け加える時にもう一つの枝を足してやることである。
(defun attacking-moves (board cur-player spare-dice)
(labels ((player (pos)
(car (aref board pos)))
(dice (pos)
(cadr (aref board pos))))
(lazy-mapcan
(lambda (src)
(if (eq (player src) cur-player)
(lazy-mapcan
(lambda (dst)
(if (and (not (eq (player dst) cur-player))
(> (dice src) 1))
(make-lazy (list
(list
(list src dst)
(game-tree (board-attack board cur-player
src dst (dice src))
cur-player
(+ spare-dice (dice dst))
nil)
(game-tree (board-attack-fail board cur-player
src dst (dice src))
cur-player
(+ spare-dice (dice dst))
nil))))
(lazy-nil)))
(make-lazy (neighbors src)))
(lazy-nil)))
(make-lazy (loop for n below *board-hexnum*
collect n)))))この確率ノードから伸びる追加の枝のゲーム盤を作るには、次に示すboard-attack-failを呼び出してやる。
board-attack-failは、ゲーム盤を受け取り、そして失敗した攻撃の攻撃元となったマスから、サイコロを1つだけ残して残りを取り上げた状態のゲーム盤を返す。
この関数は、ゲーム盤をループして、各マスを単純にコピーしている。
ただし、マスの番号が攻撃元と一致した場合に限り、そこに1個だけサイコロを残すようにする。
(defun board-attack-fail (board player src dst dice)
(board-array (loop for pos from 0
for hex across board
collect (if (eq pos src)
(list player 1)
hex))))サイコロを振るロジックを実装する。
次の関数では、引数で与えられた数のサイコロをまとめて振る。
そして、サイコロを振った結果をメッセージに表示し、合計を返す。
(defun roll-dice (dice-num)
(let ((total (loop repeat dice-num
sum (1+ (random 6)))))
(fresh-line)
(format t "On ~a dice rolled ~a. " dice-num total)
total))サイコロは常に攻撃側と守備側それぞれで振ることになるため、それらをまとめて行う関数も定義する。
この関数は単にroll-diceを2回呼び、結果を比べるのみである。
ゲーム木をたどる過程でプレイヤーがサイコロを降る手を選択したらこの関数を呼び出し、結果に応じて勝った場合の枝か、負けた場合の枝のどちらかを次のゲーム木にする。
(defun roll-against (src-dice dst-dice)
(> (roll-dice src-dice) (rill-dice dst-dice)))ゲームエンジンにとっては、サイコロを振るのは人間かコンピュータのプレイヤーが手を選んだ時に確率ノードの枝のどちらかを選ぶときだけである。
この動作は、pick-chance-branch関数で実現される。
(defun pick-chance-branch (branch move)
(labels ((dice (pos)
(cadr (aref board pos))))
(let ((path (car move)))
(if (or (null path)
(roll-against (dice (car path))
(dice (cadr path))))
(cadr move)
(caddr move)))))この関数は現在のゲーム盤と指し手のエントリを受け取り、指し手が確率ノードを持っていたら、そのどちらの枝を選ぶかを決定する。
まず、指し手のcarを、すなわちpathを見て、これがnilでなければこの指し手は攻撃なので、そこから攻撃元(car path)と攻撃先(cadr path)のマスを取り出し、それぞれのサイコロの個数を求めてroll-againstを呼び出す。
pathがnilならこの手は「手番を終える」手であるため、サイコロを振る必要はない。
サイコロを振って攻撃が成功と出れば、確率ノードの最初のゲーム木を返す。 攻撃が失敗に終われば、確率ノードの2番目のゲーム木を返す。
人間やコンピュータが指し手を選んだ時に、pick-chance-branchが呼ばれるようにする。
まず、人間側を実装する。以前のweb-handle-humanからの変更点は、次のゲームの状態を表すゲーム木を返す箇所にpick-chance-branchを足しただけである。
(defun web-handle-human (pos)
(cond ((not pos) (princ "Please choose a hex to move from:"))
((eq pos 'pass) (setf *cur-game-tree*
(cadr (lazy-car (caddr *cur-game-tree*))))
(princ "Your reinforcements have been placed.")
(tag a (href (make-game-link nil))
(princ "continue")))
((not *from-tile*) (setf *from-tile* nil)
(princ "Move cancelled."))
(t (setf *cur-game-tree*
(pick-chance-branch
(cadr *cur-game-tree*)
(lazy-find-if (lambda (move)
(equal (car move)
(list *from-tile* pos)))
(caddr *cur-game-tree*))))
(setf *from-tile* nil)
(princ "You may now ")
(tag a (href (make-game-link 'pass))
(princ "pass"))
(princ " or make another move:"))))コンピュータ側のhandle-computerも同様に変更する。
関数の最後にpick-chance-branchを加えている。
(defun handle-computer (tree)
(let ((ratings (get-ratings (limit-tree-depth tree *ai-level*) (car tree))))
(pick-chance-branch
(cadr tree)
(lazy-nth (position (apply #'max ratings) ratings) (caddr tree)))))ここまでの変更により、新しいダイスオブドゥームをプレイできるようになっているはずである。
ただ、このコードでは、ゲームAIは確率ノードのことを考慮できておらず、全ての攻撃が成功すると思って手を計算してしまう。
そこで、次章ではAIエンジンを改良して、サイコロのランダム要素を考慮できるようにする。
ゲームAIがサイコロについて考慮できるようにするためには、サイコロを振ったときの統計について知っておく必要がある。
全ての可能なサイコロの個数の組み合わせについて、攻撃が成功する確率を計算したものを表で用意しておく。
(defparameter *dice-probability* #(#(0.84 0.97 1.0 1.0)
#(0.44 0.78 0.94 0.99)
#(0.15 0.45 0.74 0.91)
#(0.04 0.19 0.46 0.72)
#(0.01 0.06 0.22 0.46)))この表は、各行が守備側のサイコロの個数(1個〜5個)、各列が攻撃側のサイコロの個数(2個〜5個)の確率を表す。
例えば、攻撃側が2個、守備側が1個の時、攻撃が成功する確率は84%である。
AIのコードの中心となる関数はget-ratingsである。
この関数は、可能な次の手それぞれに点数を与えるものであった。
点数の計算にサイコロを振る成功確率を考慮に入れる変更を施すこととする。
それぞれの攻撃について、成功した場合と失敗した場合それぞれの点数を、*dice-probability*から分かる確率を使って結合する。
この新しいget-ratings関数では、攻撃の手について、その成功確率をテーブルから取り出し、攻撃が成功した場合の点数に乗算する。
また、失敗確率(= 1 - 成功確率)を、失敗した場合の点数に乗算する。
この両者の我が、攻撃手の点数である。
これにより、get-ratings関数は確率ノードを考慮した点数を返せるようになった。
(defun get-ratings (tree player)
(let ((board (cadr tree)))
(labels ((dice (pos)
(cadr (aref board pos))))
(take-all (lazy-mapcar
(lambda (move)
(let ((path (car move)))
(if path
(let* ((src (car path))
(dst (cadr path))
(probability (aref (aref *dice-probability*
(1- (dice dst)))
(- (dice src) 2))))
(+ (* probability (rate-position (cadr move) player))
(* (- 1 probability) (rate-position (caddr move)
player))))
(rate-position (cadr move) player))))
(caddr tree))))))ゲームAIを確率ノードに完全に対応させるには、もう1つ小さな変更を行う。
ゲーム木の大きさを制限する関数は、確率ノードから2つ枝が伸びていることを考慮する。
そして、勝つ場合と負ける場合の両方の枝を刈り込む必要がある。
(defun limit-tree-depth (tree depth)
(list (car tree)
(cadr tree)
(if (zerop depth)
(lazy-nil)
(lazy-mapcar (lambda (move)
(cons (car move)
(mapcar (lambda (x)
(limit-tree-depth x (1- depth)))
(cdr move))))
(caddr tree)))))各指し手のリスト(move)のcdrに気を刈り込む関数をmapcarすることで、確率ノードの両方の枝を刈り込める。
NOTE
ダイスオブドゥームのバージョン4では、アルファベータ法は使用しない。
なぜなら、確率ノードがある場合のアルファベータ法は非常に複雑になるためである。
これまで、手番を終えた時に補給されるサイコロは、常にその手番で得たサイコロの総数 - 1であった。
この補給ルールは、ゲームが進むに連れて必ずサイコロの総数が減るため、ゲームが必ず終了し、ゲーム木が有限の大きさを持つことを保証できる。
しかし、バージョン2からゲーム木は遅延ツリーになっているため、大きさが無限になっても全く問題ない。
そこで、補給ルールを変更して、ゲームをより戦略的に面白くしてみよう。
新しいルールでは、補給サイコロの数は、プレイヤーが専有している連続した領域のうち最も大きいものの広さに等しいとする。
こうすると、プレイヤーは、常に、領域が分断されるリスクを取れるかどうかの判断を迫れられる。あるいは、小さな領域を捨てて特攻攻撃を仕掛けるという手段もある。
新たな補給ルールを実現するため、まず、指定したマスを起点として、現在のプレイヤーが専有する連続した領域のマスのリストを返すget-connectedを定義する。
この関数は、8章のGTWと同様のアルゴリズムを用いて、連続するマスを見つけ出す。
すなわち、注目しているマスから隣接するマスへと再帰的に移動しながら、既に見たマスのリストを更新していくわけである。
get-connected関数では、2つのローカルな再帰関数を定義している。
check-pos関数は現在見ているマスがプレイヤーの所有であり、かつまだ見たことがなければそれをvisitedリストに追加する。check-neighbors関数は隣接したマスのリストを受け取ってその全てをチェックする。
この2つの関数は、相互に再帰して、連続したマスの一塊を見つけ出す。
(defun get-connected (board player pos)
(labels ((check-pos (pos visited)
(if (and (eq (car (aref board pos)) player)
(not (member pos visited)))
(check-neighbors (neighbors pos) (cons pos visited))
visited))
(check-neighbors (lst visited)
(if lst
(check-neighbors (cdr lst) (check-pos (car lst) visited))
visited)))
(check-pos pos '())))相互再帰の起点は、目標のマス1つと、空のvisitedリストでcheck-posを呼び出すことである。
この関数で連続するマスの1つの領域は見つけられるが、最大の領域を見つけるために、largest-cluster-size関数が必要となる。
(defun largest-cluster-size (boardd player)
(labels ((f (pos visited best)
(if (< pos *board-hexnum*)
(if (and (eq (car (aref board pos)) player)
(not (member pos visited)))
(let* ((cluster (get-connected board player pos))
(size (length cluster)))
(if (> size best)
(f (1+ pos) (append cluster visited) size)
(f (1+ pos) (append cluster visited) best)))
(f (1+ pos) visited best))
best)))
(f 0 '() 0)))最後に、この新しい補給ルールを反映するため、add-new-diceを変更する。
(defun add-new-dice (board player spare-dice)
(labels ((f (lst n)
(cond ((zerop n) lst)
((null lst) nil)
(t (let ((cur-player (caar lst))
(cur-dice (cadar lst)))
(if (and (eq cur-player player) (< cur-dice *max-dice*))
(cons (list cur-player (1+ cur-dice))
(f (cdr lst) (1- n)))
(cons (car lst) (f (cdr lst) n))))))))
(board-array (f (coerce board 'list)
(largest-cluster-size board player)))))新しいadd-new-diceでもspare-dice引数を受け取っているが、これはadd-new-diceを呼び出している箇所との互換性のためだけで、この引数は無視される。
すなわち、追加される補給サイコロの数は最も大きな連続領域の大きさのみで決まる。
add-new-dice関数の変更箇所はここのみである。
これで、新たな補給ルールを有効にするための全てのコードが完成した。
この設計では、ゲームAIのプレイヤーがゲーム木の全てにアクセスできるようになっている。
ゲーム木はこの新たな補給を考慮したデータを持つので、ゲームAIは自動的に新たな補給ルールに合わせた最適な戦略を見つけるようになる。
ダイスオブドゥームのゲームは、これにて完成である。
プレイするには、下記のとおりコマンドを実行する。
> (serve #'dod-request-handler)そして、webブラウザでゲームページを開く。
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment