プログラミングを頑張る日記

プログラミングを勉強して、ハッカーになろう

Common Lispを頑張る(6)

本日は「Land of Lisp」の第5章の残りをやっていきます。

たしか前回は、
・場所の景色を描写する。
・ある場所からある場所への道を描写する。
というところまでやったのでした。

今回は特定の場所にあるオブジェクトの描写からです。
まずはゲーム世界にあるオブジェクトのリストを作ります。

CL-USER> (defparameter *objects* '(牛のミルク 旅人の服 栗毛の馬 勇者の剣))
*OBJECTS*
CL-USER>

次にオブジェクトと置いてある場所を紐づけます。

CL-USER> (defparameter *object-locations* '((牛のミルク はじまりの村)
					   (旅人の服 活気ある街)
					   (栗毛の馬 活気ある街)
					   (勇者の剣 王様の城)))
*OBJECT-LOCATION*
CL-USER>

すると与えられた場所にあるオブジェクトを返す関数は次のようにかけるそうです。

CL-USER> (defun objects-at (loc objs obj-locs)
	   (labels ((at-loc-p (obj)
		      (eq (cadr (assoc obj obj-locs)) loc)))
	     (remove-if-not #'at-loc-p objs)))
OBJECTS-AT
CL-USER> (objects-at '活気ある街 *objects* *object-locations*)
(旅人の服 栗毛の馬)
CL-USER>

今までの自分ならとっとと解説を見ていましたが、もう大丈夫です!多分。
名前等からしてremove-if-notは指定された関数を引数のリストに適用して、
偽を返してきた要素を除いたリストを返してきそうな感じがします。
で、その適用している関数はlabelsで定義されているat-loc-pですね。
これは単純に、引数として渡された場所と、物がある場所を比較していますな。
で、場所の名前が一致したら真となり、その場所にあるものだけのリストが返ると。
よし!読めました!小さいですが進歩です。

さて、あとはその場所で見えるオブジェクトを描写する関数を書くだけです。
今回は参考書を見る前に自分で考えて書きます。なんかノリノリなので。
基本的には前回describe-pathsを書いたときと同じようにすればいいはずです。
つまり高階関数applyとmapcarを使えば…。

CL-USER>  (defun describe-object (obj)
	   `(この場所では,(car obj)が手に入る予感がする。))
WARNING: redefining COMMON-LISP:DESCRIBE-OBJECT in DEFUN
; Evaluation aborted on #<SYMBOL-PACKAGE-LOCKED-ERROR "setting fdefinition of ~A" {10022DF853}>.
CL-USER> (defun describe-obj (obj)
	   `(この場所では,(car obj)が手に入る予感がする。))
DESCRIBE-OBJ
CL-USER> 

問題ないと思ってたらいきなりのエラーでビビりました。
調べてみたところdescribe-objectという名前の関数があって、
それを再定義しようとしたから怒られたみたいでした。名前を変えればOKですね。

CL-USER> (defun describe-objs (loc objs obj-locs)
	   (apply #'append (mapcar #'describe-obj (objects-at loc objs obj-locs))))
DESCRIBE-OBJS
CL-USER> (describe-objs '活気ある街 *objects* *object-locations*)
; Evaluation aborted on #<TYPE-ERROR expected-type: LIST datum: 旅人の服>.
CL-USER>

リストを期待してたのに!って怒られている気がします。ダメか…。
ちょっとdescribe-objを直してみます。

CL-USER> (defun describe-obj (obj)
	   (list 'この場所では obj 'が手に入る予感がする))
WARNING: redefining COMMON-LISP-USER::DESCRIBE-OBJ in DEFUN
DESCRIBE-OBJ
CL-USER> (describe-objs '活気ある街 *objects* *object-locations*)
(この場所では 旅人の服 が手に入る予感がする この場所では 栗毛の馬 が手に入る予感がする)
CL-USER>

できた…append使って怒られたりobjって名前の関数は知らないって怒られたりもしました。
無駄に長くなってしまいそうなので報告にとどめます。
それでは参考書を使って書き直してみます。

CL-USER> (defun describe-objects (loc objs obj-locs)
	   (labels ((describe-obj (obj)
		      `(この場所には ,obj があるかもしれない。)))
	     (apply  #'append (mapcar #'describe-obj (objects-at loc objs obj-locs)))))
WARNING: redefining COMMON-LISP-USER::DESCRIBE-OBJECTS in DEFUN
DESCRIBE-OBJECTS
CL-USER> (describe-objects '活気ある街 *objects* *object-locations*)
(この場所には 旅人の服 があるかもしれない。 この場所には 栗毛の馬 があるかもしれない。)
CL-USER>

一回、describe-objの部分で空白を入れない文章で書いたら実行時にいっぱい怒られました。
とはいえ「,'(要素 ,変数 要素)」で埋め込めるのですね。
アンクオートするときには括弧で囲むものだと勝手に思い込んでました。
だから自分で考えた方はlist使ってたので。思いつくべきではありましたね。

地味に主人公の異様に鋭かった勘をほんのちょっとマイルドにもしています。

ここまでの処理をまとめる

周りの情報全てをlookというコマンドで得られるようにします。
周りの情報、ということは今どこにいるかの情報を保持する関数が必要です。

CL-USER> (defparameter *location* 'はじまりの村)
*LOCATION*
CL-USER>

もちろん開始地点ははじまりの村です。ここは主人公の故郷です。そう決めた気がします。
ちょっと横のページが目に入り、look関数は関数的でないという情報が目に入りました。
そしてここで定義した*location*変数…つまりグローバル変数を使って良いんですね!

これだけのヒントがあれば十分なのでさっさと書いていきます。

CL-USER> (defun look ()
	   (append (describe-location *location* *node*)
		   (describe-paths *location* *edges*)
		   (describe-objects *location* *objects* *object-locations*)))
LOOK
CL-USER> (look)
(あなたははじまりの村にいる。 どこからか牛の鳴き声が聞こえる。 東 には 街道 があり、 活気ある街 へと続いている。 この場所には 牛のミルク
 があるかもしれない。)
CL-USER

変なところで改行されちゃいましたが、できました。
関数型のプログラムとは、同じ引数を与えたらいつでも同じ値を返すものだそうで、
これはゲーム中いる場所によって返ってくる結果に違っていてほしいので関数型では無理ですね。

キーワード引数

CL-USER> (defun walk (direction)
	   (let ((next (find direction
			     (cdr (assoc *location* *edges*))
			     :key #'cadr)))
	     (if next
		 (progn (setf *location* (car next))
			(look))
		 '(考えてみたが、そっちに行きたいところはない))))
WALK
CL-USER> (walk ')
(あなたは活気ある街にいる。 大通りには露店が並んでいて、あちこちで交渉が行われている。 西 には 街道 があり、 はじまりの村 へと続いている。 街の中心
 には 橋 があり、 王様の城 へと続いている。 この場所には 旅人の服 があるかもしれない。 この場所には 栗毛の馬 があるかもしれない。)
CL-USER> (walk ')
(考えてみたが、そっちに行きたいところはない)
CL-USER>

いきなりサンプルコードの書経をしてしまいました。
というのもページを捲った瞬間、:keyとかいうのが見えたので…。

でも知らないコマンドはfindだけですね。こいつさえわかれば敵なしです。
find関数は、リストから与えた要素を探す関数だそうです。

CL-USER> (find '1 '(5 4 3 2 0 -1 1))
1
CL-USER>

前準備としてassocで*edges*から今の場所から利用できる通り道を探します。

CL-USER> (cdr (assoc *location* *edges*))
((はじまりの村 西 街道) (王様の城 街の中心 橋))
CL-USER>

はい、*edges*はalistなのでassocで抜けるのでした。cdrがデータの部分です。
しかしこれで得られるのはリストなのでdirectionで検索しても引っかかりません。
cadrの部分が欲しい…そこと比較したい…というわけでやっと:keyの話が書けます。

上で書いたようなことを実現してくれるのがキーワード引数だそうです。
Common Lispの多くの関数が関数呼び出しのあとに特別な引数を付けて
組み込みの機能を使えるようになるということ。
今回のキーワード引数は2つの部分から成っていて、
コロンで始まる:keyと値そのものとして#'cadrです。

CL-USER> (find '犯人 '((容疑者 ナイフ) (容疑者 スプーン) (犯人 バールのようなもの))
	       :key #'car)
(犯人 バールのようなもの)
CL-USER>

findの用法さえわかってしまえばこのnext関数は簡単ですね。
行きたい方向を受け取り、それがここから行ける場所として設定されているか確認し
結果をnextに格納。もしnextに値が格納されていれば行き先を新しい*location*として
lookします。もしfindで何も見つからなければ、nextはnilなのでどこにも行けません。

push

次はオブジェクトを手に入れられるようにします。またまた写経です。

CL-USER>  (defun pickup (object)
	   (cond ((member object
			  (objects-at *location* *objects* *object-locations*))
		  (push (list object 'body) *object-locations*)
		  `(あなたは ,object を手に入れた!))
		 (t '(それはここには無いようだ。))))
WARNING: redefining COMMON-LISP-USER::PICKUP in DEFUN
PICKUP
CL-USER>

もう定義してるぞ、と注意されているのは一回ちょっとミスったからです。
知らない関数は2つありますね。memberとpushです。
member関数はリストの中に要素があるかをチェックするそうです。
condの直後にあるということはあったら真というわけですね。
まあ、発見した要素を返してくれてるのかも知れませんが。
確実なのは見つからなかったらnilを返してくれそうだということですね。
pushは…リストに新しい要素を付け加える関数でしょうか。

CL-USER> (push '1 '(ここに 1が 来てくれるはず))
; in: PUSH '1
;     (FUNCALL #'(SETF QUOTE) #:NEW1 #:G501)
; ==>
;   (SB-C::%FUNCALL #'(SETF QUOTE) #:NEW1 #:G501)
; 
; caught WARNING:
;   The function (SETF QUOTE) is undefined, and its name is reserved by ANSI CL so
;   that even if it were defined later, the code doing so would not be portable.

;     (ここに 1が 来てくれるはず)
; 
; caught WARNING:
;   undefined variable: 1が
; 
; caught STYLE-WARNING:
;   undefined function: ここに
; 
; caught WARNING:
;   undefined variable: 来てくれるはず
; 
; compilation unit finished
;   Undefined functions:
;     (SETF QUOTE) ここに
;   Undefined variables:
;     1が 来てくれるはず
;   caught 3 WARNING conditions
;   caught 1 STYLE-WARNING condition
; Evaluation aborted on #<UNBOUND-VARIABLE 1が {10045BF0C3}>.
CL-USER>

凄い怒られました。
pushは、リストを保持している変数の先頭に新しい要素を付け加えるそうです。

CL-USER> (defparameter *hoge* '(これなら 1が 来てくれるはず 先頭に))
*HOGE*
CL-USER> (push '1 *hoge*)
(1 これなら 1が 来てくれるはず 先頭に)
CL-USER>

よし。できました。
pushで*object-locations*に新しい要素を付け加えると以前オブジェクトが合った場所の
情報も残ってしまいますがそれで良いそうです。
objects-atで利用しているassoc関数は先頭から検索するため、最初に見つけたエントリを返すためだそう。
pushとassocを使ってalistの値が更新されたように見せ、
その実すべての履歴を保持するというのはLisperがよく使うテクニックだそうです。

最初の村に戻って牛乳をゲットしてみます。

CL-USER> (walk '西)
(あなたははじまりの村にいる。 どこからか牛の鳴き声が聞こえる。 東 には 街道 があり、 活気ある街 へと続いている。 この場所には 牛のミルク
 があるかもしれない。)
CL-USER> (pickup '牛のミルク)
(あなたは 牛のミルク を手に入れた!)
CL-USER> (pickup '牛のミルク)
(それはここには無いようだ。)
CL-USER> 

うまいこと動いているようです。

最後は自分が今持っているものを確認する関数を作ります。
それぐらいなら書ける気がするのでやってみます。

CL-USER> (defun my-items ()
	   (labels ((my-item (obj)
		      `(あなたは ,obj を持っている。)))
	     (apply  #'append (mapcar #'my-item (objects-at 'body *objects* *object-locations*)))))
MY-ITEMS
CL-USER> (my-items)
(|あなたは | 牛のミルク を持っている。)
CL-USER>

見栄を張ってみましたがやってることはdescribe-objectsを関数型じゃなくしただけです。
しかも謎の縦棒が入っています。…なんだこれは。

CL-USER> (defun my-items ()
	   (labels ((my-item (obj)
		      `(あなたは ,obj を持っている。)))
	     (apply  #'append (mapcar #'my-item (objects-at 'body *objects* *object-locations*)))))
WARNING: redefining COMMON-LISP-USER::MY-ITEMS in DEFUN
MY-ITEMS
CL-USER> (my-items)
(あなたは 牛のミルク を持っている。)
CL-USER>

,objの前のスペースが全角になっていたのが原因みたいでした。
てことは、半角スペースを入れなくてもアンクオートできるんですね。

さて、参考書を見て書き直します。

CL-USER> (defun inventory ()
	   (cons '持ち物... (objects-at 'body *objects* *object-locations*)))
INVENTORY
CL-USER> (inventory)
(持ち物... 牛のミルク)
CL-USER>

ふう、シンプルでした。
とはいえこちらのほうが後々cdrで持ち物を参照したりするかも知れないのでいいですね。
…これまで自分で書いてきたコードが後の章で役に立たなかったら悲しいですね。
まあ!そしたら合わせて使えるようにうまいこと書き換えればいいだけですが!

という感じで今日は終わりです。
この章でも大切そうなことがいっぱい出てきたのでちょくちょく復習します。