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

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

Common Lispを頑張る(61)

「Land of Lisp」も16章まで来ました。ついに皆大好きマクロの話です。

細かい話はすっとばして、例を見ます。
letを使うと括弧が多くなってウザいのでもっとスマートなletが欲しい、というのが例ですね。

CL-USER> (defmacro let1 (var val &body body)
           `(let ((,var ,val))
              ,@body))
LET1
CL-USER> (let1 foo (+ 2 4)
           (* foo foo))
36
CL-USER> (macroexpand-1
          '(let1 foo (+ 2 4)
           (* foo foo)))
(LET ((FOO (+ 2 4)))
  (* FOO FOO))
T
CL-USER>

バッククォートの中の式は基本的に評価されず、コンマを使うことで評価対象とでき、
,@は評価した結果のリストを外のリストと繋ぎあわせるのでした。楽勝ですね。

…楽勝ですねこの章。という訳で今日はもうここまで。
眠いけど新年せっかく更新が続いているので姑息な更新でした。僕は卑怯者だ…!
というわけでおやすみなさい。

Common Lispを頑張る(60)

「Land of Lisp」、末尾呼び出し最適化をやっていきます。

末尾呼び出し最適化

まず例としてリストの長さを求める関数を考えていきます。

CL-USER> (defun my-length (lst)
           (if lst
               (1+ (my-length (cdr lst)))
               0))
MY-LENGTH
CL-USER> (my-length '(1 2 3))
3
CL-USER>

簡単なよくある感じのプログラムだと思います。
しかし、このタイプの関数は非常に効率が悪いそうです。
再帰で呼び出した関数が返ってきて初めてスタックから解放されるためです。
10000個の要素があるリストに対して実行した場合、9999個スタックを積んだ後にようやく1+が実行されます。
著者のCLispはクラッシュしたそうです。流石に現代のSBCLは大丈夫だと思いますが怖いのでやめときます。

どうすればいいのか、という回答のmy-lengthの改良版がこちらになります。

CL-USER> (defun my-length (lst)
           (labels ((f (lst acc)
                      (if lst
                          (f (cdr lst) (1+ acc))
                          acc)))
             (f lst 0)))
WARNING: redefining COMMON-LISP-USER::MY-LENGTH in DEFUN
MY-LENGTH
CL-USER>

よく読みます。fというローカル関数を定義。これはlstとaccを受け取り、
lstがnilでなければlstのcdrとaccに1足したものを引数に再帰的に自分を呼び出します。
そんなに難しくないですね。

さて、ここでのポイントは、「返ってきた結果に1を足していた」改良前と違い、
「1を足した引数で再帰していること」のようです。
よって再帰した結果が返ってきた後にやることがありません。最後にやっていることは自分を呼び出すことです。
これこそ「末尾呼び出し」と呼ばれるものの正体のようです。
コンパイラは末尾呼び出しを見ると、今までの処理をスタックせずに次の処理に取りかかるそう。

Common Lispと末尾呼び出し最適化

残念なこととして、末尾呼び出し最適化はANSIの規格で要求されているわけではないので、
全ての処理系で最適化されるとは限りません。Schemeでは規格で定められているよう。羨ましい。
CLISPだと末尾呼び出し最適化を有効にするために一手間いるようですが、SBCLでは何もせずとも有効なよう。

ゲームを末尾呼び出し最適化する

まずは、ターンの終わりにサイコロを補給するadd-new-dice関数に適用してみるようです。
確かこいつは、補給できるサイコロの残りの数とかをわざわざ覚えていたはずです。そこですね。

CL-USER> (defun add-new-dice (board player spare-dice)
           (labels ((f (lst n acc)
                      (cond ((zerop n) (append (reverse acc) lst))
                            ((null lst) (reverse acc))
                            (t (let ((cur-player (caar lst))
                                     (cur-dice (cadar lst)))
                                 (if (and (eq cur-player player)
                                          (< cur-dice *max-dice*))
                                     (f (cdr lst)
                                        (1- n)
                                        (cons (list cur-player (1+ cur-dice)) acc))
                                     (f (cdr lst)
                                        n
                                        (cons (car lst) acc))))))))
             (board-array (f (coerce board 'list) spare-dice ()))))
WARNING: redefining COMMON-LISP-USER::ADD-NEW-DICE in DEFUN
ADD-NEW-DICE
CL-USER>

なかなか複雑に見えますが落ち着いて見ていきたいと思います。
本体部分では、board-arrayはリストを配列にするだけだから置いといて、
fを盤面の状態をリストにしたもの、補給可能なダイスの数、空リストを引数に呼び出しています。
fの中ではまず、補給可能なダイスが無ければaccを逆順にしたものとlstをくっつけて返します。
lstがnilならaccを逆順にしたものを返します。lstがnilってことは再帰が最後のコマまでいったということだからですね。
どちらでもなければ、今みているマスのプレイヤーとダイスの数を変数に格納します。
そして補給の条件に合っているか確認し、合っていればfに残りの盤面、「新たな」補給可能数、
accに処理が済んだマスを格納し引数とします。
再帰するとき、accに前のマスから入れていくからreverseして戻り値にしているのですね。

これで完成です。
3*3のゲームが動くかどうか確認して終わります。

CL-USER> (play-vs-computer (game-tree (gen-board) 0 0 t))
current player = a
      b-1 a-1 a-1 
    a-2 b-3 b-3 
  a-1 b-1 a-2 
choose your move:
1. 3 -> 0
2. 3 -> 7
3. 8 -> 7
3

動きました。何回かやりましたが、まともにお互いにコマが揃っていると勝てないですね。

次の章はいよいよこちらの参考書でもマクロが出てきます。楽しみです。おやすみなさい。

Common Lispを頑張る(59)

やります「Land of Lisp」、本日はダイス・オブ・ドゥームの改善です

メモ化

クロージャ

最適化を始める前に、ついにクロージャの登場です。
クロージャはlambdaで関数が作られるときに外界の情報を補足したもの」という説明があります。
とりあえず例を。

CL-USER> (defparameter *foo* (let ((x 5))
                               (lambda () x)))
*FOO*
CL-USER> (funcall *foo*)
5
CL-USER>

xを定義して、それをラムダ式で返してくるだけの関数を作り、funcallで呼び出しています。
xはletで定義されているのに、後のfuncallでの呼び出しの時でもxが5であることを覚えている! というのがポイントのようです。
funcallで呼び出した時にletがまた動いていたりはしないんですかね。

CL-USER> (defparameter *hoge* 5)
*HOGE*
CL-USER> (defparameter *foo* (let ((x *hoge*))
                               (lambda () x)))
*FOO*
CL-USER> (funcall *foo*)
5
CL-USER> (defparameter *hoge* 10)
*HOGE*
CL-USER> (funcall *foo*)
5
CL-USER>

なるほど。疑ってもうしわけない。

さて、何故このようになるのか。ガベージコレクタと絡めると理解しやすいそうです。
ガベージコレクタはどこからも参照されていないメモリを見つけたら自動的に解放してくれる仕組みですが、
上記のようなレキシカル変数は、let式を抜けたあとでもlambdaの中で参照されているため
lambda式自体がガベージコレクタに解放されるまでは残り続けるということです。わかりやすい。
これを利用することで関数呼び出し間でちょっとした情報を保持することができるので楽しいって話ですね。

メモ化

クロージャを利用した最適化のテクニックがメモ化です。
関数型のコードでは関数の振る舞いは渡された引数にのみ依存します。関数は値を計算して返すだけです。
同じ値が来たら常に同じ値を返す…。
ということは、一回来たことのある引数だったらわざわざ新しく計算し直さなくていいのでは?
というのがメモ化のようです。

まずは与えられた場所に隣接しているマスを返すneighors関数をメモ化しましょう。
マスの場所はころころ変りませんから妥当ですね。元を再掲します。

CL-USER> (defun neighbors (pos)
           (let ((up (- pos *board-size*)) ;対象のマスの上下を定義
                 (down (+ pos *board-size*)))
             (loop for p in (append (list up down)
                                    (unless (zerop (mod pos *board-size*)) ;posが左端でなければ
                                      (list (1- up) (1- pos))) ;左上と左側のマスを追加
                                    (unless (zerop (mod (1+ pos) *board-size*)) ;posが右端でなければ
                                      (list (1+ pos) (1+ down)))) ;右側と右下のマスを追加
                  when (and (>= p 0) (< p *board-hexnum*))
                  collect p)))          ;ゲーム盤に収まるマスを集めてリストにする
NEIGHBORS
CL-USER>

これがこうなるようです。

CL-USER> (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)))))
WARNING: redefining COMMON-LISP-USER::NEIGHBORS in DEFUN
NEIGHBORS
CL-USER>

理解しなくてはいけないのは、old-neighborsの部分でした。
symbol-functionは引数のシンボルに束縛されている関数を取り出すコマンドであり、
それで元々のneighborsをold-neighborsに束縛します。
それとpreviousというハッシュテーブルを作成し、neighborsが呼ばれるたびにその引数をキーにした値があるか
previousから調べ、なければ旧式の関数を使い結果をpreviousに保存します。
うーん、クールな動き。

さて、それよりメモ化すべきようなものがある気がしますね。game-tree関数です。
同じ手順でいけるのかな。

CL-USER> (let ((old-game-tree (symbol-function 'game-tree))
               (previous (make-hash-table :test #'equalp)))
           (defun game-tree (&rest rest)
             (or (gethash rest previous)
                 (setf (gethash rest previous) (funcall old-game-tree rest)))))
WARNING: redefining COMMON-LISP-USER::GAME-TREE in DEFUN
GAME-TREE
CL-USER>

危ない。ここでequalpを使う理由は、キーに配列が含まれているからだそう。
https://lisphub.jp/common-lisp/cookbook/index.cgi?%E9%85%8D%E5%88%97%E4%B8%AD%E3%81%AE%E8%A6%81%E7%B4%A0%E3%82%92%E6%8E%A2%E3%81%99
上記リンクでも同じようなことが例として出ています。比較難しい。

あと、rate-positionもメモ化の効率が高いそう。
再帰しまくる系の関数たちはメモ化の効率がいいというか、普通に動かしていたら効率が悪いのでしょうな。
ちょっとこれまでより難しそう。

CL-USER> (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))))))
WARNING: redefining COMMON-LISP-USER::RATE-POSITION in DEFUN
RATE-POSITION
CL-USER>

…。参考書に頼る前にちょっと落ち着いて見てみます。
tabを作るところまでは問題ありません。
playerをキーにprevousを検索して見つかった値をtabにセット、値が見つからなかったら、
まずprevious内にplayerをキーとした空のハッシュテーブルを作成。更にそれをtabにセット。
引数の内、treeをキーにtabを検索、見つからなければtreeをキーに以前のrate-positionを実行した結果を保存。

まずplayerで検索することで検索を効率化しているのかな。2人いるとしたらまとめて検索する量の二分の一にできますもんね。
整理。previousはキーがplayerで、値が...値はtabか。gethashなら共有してそうだしそうでなければ説明がつかない。
tabはキーがtree。値が指し手の評価値。

参考書を確認したら大体合っていそう。
ゲームツリーが巨大すぎるのでそのまま検索すると結局効率が悪くこうなるとのこと。

明日は末尾最適化とやらからやっていきます。またまたワクワクするワード。おやすみなさい。

Common Lispを頑張る(58)

それではやっていきます、「Land of Lisp」。
今日の目標は、コンピュータによる対戦相手を実装することです。

AIプレイヤー(?)の実装

AIはどう手を選べばいいのでしょうか、それには次のような戦略が使えるといいます。
・可能な手それぞれについて、その手を指すことで生じる盤面の状態に点数をつけ、最も高い点数の手を選ぶ
盤面の状態の点数化は、そこからゲーム終了までゲームツリーを見て、勝つことのできる手なら点数をつける、
という風にすればよいでしょう。
これは相手の手について考えるときにも同じように考えることができ、相手の手に点数をつけるときも同じようにし、
ただしその中で一番点数の低い手(AIにとって悪い手)を常に選んでくる、という風にしてあげれば
相手の手を読んで手を選択する、みたいな動作ができるはずです。
なるほどなあ、と感心しています。

CL-USER> (defun rate-position (tree player)
           (let ((moves (caddr tree)))
             (if moves                  ;指せる手があるか?
                 (apply (if (eq (car tree) player) ;指し手によって最大を取るか最小を取るか
                            #'max
                            #'min)
                        (get-ratings tree player))
                 (let ((w (winners (cadr tree)))) ;ツリーの最後まで来た
                   (if (member player w)          ;勝者の一覧に自分がいるか?
                       (/ 1 (length w))           ;勝者で1点を分けあう
                       0)))))                     ;勝ってなきゃ0点
; in: DEFUN RATE-POSITION
;     (GET-RATINGS TREE PLAYER)
; 
; caught STYLE-WARNING:
;   undefined function: GET-RATINGS
; 
; compilation unit finished
;   Undefined function:
;     GET-RATINGS
;   caught 1 STYLE-WARNING condition
RATE-POSITION
CL-USER> (defun get-ratings (tree player)
           (mapcar (lambda (move)
                     (rate-position (cadr move) player)) ;受けとったツリーの今の全ての枝に
                   (caddr tree)))                        ;rate-positionを実行
GET-RATINGS
CL-USER>

よし、もうAIの頭脳の部分は出来たといっていいでしょう。
それでは実際に上の関数を利用して手を選択する部分を作成します。

CL-USER> (defun handle-computer (tree)
           (let ((ratings (get-ratings tree (car tree)))) ;可能な指し手の点数のリストをratingsとする
             (cadr (nth (position (apply #'max ratings) ratings) (caddr tree))))) ;一番点数の高い最初のツリーを返す
HANDLE-COMPUTER
CL-USER>

3行目で一瞬悩みましたが、ratingsの最大値の場所を調べて同じ位置にあるツリーを返しているということですね。

じゃあ、残りは対戦を司る部分。

CL-USER> (defun play-vs-computer (tree)
           (print-info tree)
           (cond ((null (caddr tree)) (announce-winner (cadr tree))) ;もう手がなければ決着のアナウンス
                 ((zerop (car tree)) (play-vs-computer (handle-human tree))) ;人間の手番なら人間にターンを渡して再帰
                 (t (play-vs-computer (handle-computer tree))))) ;それ意外ならAIのターンのあと再帰
PLAY-VS-COMPUTER
CL-USER>

完成です! 嬉しい。なんか強そうな気がするんですが遊んでみます。

CL-USER> (play-vs-computer (game-tree (gen-board) 0 0 t))
current player = a
    b-3 b-2 
  a-2 a-3 
choose your move:
1. 3 -> 1
1
current player = a
    b-3 a-2 
  a-2 a-1 
choose your move:
1. end turn
1
current player = b
    b-3 a-3 
  a-2 a-1 
current player = b
    b-1 a-3 
  b-2 a-1 
current player = a
    b-2 a-3 
  b-2 a-1 
choose your move:
1. 1 -> 0
1
current player = a
    a-2 a-1 
  b-2 a-1 
choose your move:
1. end turn
1
current player = b
    a-3 a-1 
  b-2 a-1 
current player = b
    a-3 a-1 
  b-1 b-1 
current player = a
    a-3 a-1 
  b-1 b-1 
choose your move:
1. 0 -> 2
2. 0 -> 3
1
current player = a
    a-1 a-1 
  a-2 b-1 
choose your move:
1. end turn
2. 2 -> 3
2
current player = a
    a-1 a-1 
  a-1 a-1 
choose your move:
1. end turn
1
current player = b
    a-2 a-1 
  a-1 a-1 
The winner is a
NIL
CL-USER>

普通に遊べるクオリティではあります。甘すぎかもしれません。
まあ、面白くてたまらないというレベルではありませんけど、ちゃんと動いているというのが大事です。

なぜ面白くないのか。単純にゲーム盤が小さいというのが大きな理由ですね。
せっかくのAIなのにゲーム性が広がりません。
おっきくしましょう。とりあえず3*3でいいかな。

CL-USER> (defparameter *board-size* 3)
*BOARD-SIZE*
CL-USER> *board-hexnum*
4
CL-USER> (defparameter *board-hexnum* (* *board-size* *board-size*))
*BOARD-HEXNUM*
CL-USER>

よし、ゲーム盤を縦横1マスずつ拡張しました。
遊んでみます。

CL-USER> (play-vs-computer (game-tree (gen-board) 0 0 t))
current player = a
      b-2 b-3 a-1 
    b-2 a-2 a-1 
  a-1 b-1 b-2 
choose your move:
1. 4 -> 7
1
current player = a
      b-2 b-3 a-1 
    b-2 a-1 a-1 
  a-1 a-1 b-2 
choose your move:
1. end turn
1
current player = b
      b-2 b-3 a-1 
    b-2 a-1 a-1 
  a-1 a-1 b-2 
current player = b
      b-1 b-3 a-1 
    b-2 b-1 a-1 
  a-1 a-1 b-2 
current player = a
      b-1 b-3 a-1 
    b-2 b-1 a-1 
  a-1 a-1 b-2 
The winner is b
NIL
CL-USER> (play-vs-computer (game-tree (gen-board) 0 0 t))

返ってこなくなりました。1回目みたいにすぐ終わるゲームでなければ
ゲームツリーの生成に相当時間がかかってしまうようです。

遊べなくなってしまっては、もはやゲームとして成り立ちません。悲しい…。

というわけで次回からは、高速化・効率化をしていきます。

Common Lispを頑張る(57)

今日も「Land of Lisp」でダイス・オブ・ドゥームを作っていきます。
昨日まででルールエンジンの部分はできたので、プレイするための残りの部分をやっていきます。

人間同士の対戦機能

ゲームツリーを作る機能は完成しています。そこから人間同士でプレイするゲームにするのは簡単だそう。
プレイヤーの選んだ手に従ってゲームツリーを辿っていくだけでいいと、なるほど。

CL-USER> (defun play-vs-human (tree)
           (print-info tree)
           (if (caddr tree)
               (play-vs-human (handle-human tree))
               (announce-winner (cadr tree))))
; in: DEFUN PLAY-VS-HUMAN
;     (ANNOUNCE-WINNER (CADR TREE))
; 
; caught STYLE-WARNING:
;   undefined function: ANNOUNCE-WINNER

;     (HANDLE-HUMAN TREE)
; 
; caught STYLE-WARNING:
;   undefined function: HANDLE-HUMAN

;     (PRINT-INFO TREE)
; 
; caught STYLE-WARNING:
;   undefined function: PRINT-INFO
; 
; compilation unit finished
;   Undefined functions:
;     ANNOUNCE-WINNER HANDLE-HUMAN PRINT-INFO
;   caught 3 STYLE-WARNING conditions
PLAY-VS-HUMAN
CL-USER>

現在の状態およびそこから伸びる全ての手を含むゲームツリーを引数にとり、
print-infoで現在の盤面を表示し、次にゲームツリーのcaddr部分を調べ現状可能な手が残っているか、
残っているなら可能な手をhandle-humanで選択させ、
残っていなければannounce-winnerで決着のアナウンスといった感じでしょうかね。

それではまずprint-info関数を片づけます。

CL-USER> (defun print-info (tree)
           (fresh-line)
           (format t "current player = ~a" (player-letter (car tree)))
           (draw-board (cadr tree)))
PRINT-INFO
CL-USER>

ゲームツリーの構成さえ分かっていれば簡単な関数ですね。いや、実はそこが正直曖昧なんですが。

じゃあhandle-humanです。ここでは可能な全ての指し手を説明をつけて番号と一緒に表示し、
選んでもらうようにするようです。

CL-USER> (defun handle-human (tree)
           (fresh-line)
           (princ "choose your moce:")
           (let ((moves (caddr tree)))  ;可能な手をmovesへ
             (loop for move in moves    ;moveに1つずつ入れる
                   for n from 1         ;番号を振る
                  do (let ((action (car move))) ;actionは(自マス そこから攻撃可能なマス)となる
                       (fresh-line)
                       (format t "~a. " n)
                       (if action       ;可能な攻撃があれば
                           (format t "~a -> ~a" (car action) (cadr action))
                           (princ "end turn"))))
             (fresh-line)               ;全ての手の表示が終わったら改行して入力を待つ
             (cadr (nth (1- (read)) moves)))) ;選択された分岐のツリーを返す
HANDLE-HUMAN
CL-USER> 

そういえばここらはプレイヤーと接する部分だからしょうがないんですが不浄です。

勝者を宣言する機能は、清浄な部分と不浄な部分に切り分けることができます。
勝者を判定する部分だけを実装すればその関数は清浄に保つことができますね。
後の拡張を考え、プレイヤーの数に左右されないようにします。引分けになることもありますね。
そんな関数winnersを作ります。

CL-USER> (defun winners (board)
           (let* ((tally (loop for hex across board ;ゲーム盤を走査し各マスの所有者のリストを
                              collect (car hex))) 
                  (totals (mapcar (lambda (player) ;マスを所有しているプレイヤーがいくつマスを
                                    (cons player (count player tally))) ;所有しているか
                                  (remove-duplicates tally)))
                  (best (apply #'max (mapcar #'cdr totals)))) ;一位のプレイヤーの所有マスの数
             (mapcar #'car                                    ;勝者のリストを作る
                     (remove-if-not (lambda (x) ;totalsからマスの所有数が1位タイでない
                                      (not (eq (cdr x) best))) ;プレイヤーの要素を除外
                                    totals))))
WINNERS
CL-USER>

よし。あとはここで得た結果を教えてくれる不浄な関数を作るだけです。

CL-USER> (defun 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 winener is ~a" (player-letter (car w))))))
ANNOUNCE-WINNER
CL-USER>

複数1位が出た時と1人の1位が出た時で出力する文章を変えているだけですね。

これで2人で遊べるダイス・オブ・ドゥームの完成です。
2人になったつもりで遊んでみます。

CL-USER> (play-vs-human (game-tree (gen-board) 0 0 t))
current player = a
  b-3 b-2 
 a-2 a-3 
choose your moce:
1. 3 -> 1
1
.
.
.
choose your moce:
1. end turn
1
current player = b
  a-2 a-1 
 a-1 a-1 
; Evaluation aborted on #<TYPE-ERROR expected-type: NUMBER datum: NIL>.
CL-USER>

いい感じだったんですが、announcei-winnerでplayer-letterを呼び出す時にnilが渡ってしまいました。
犯人として真先に疑うべきはwinnersですね。
全マスをプレイヤー1が占領した時に起きたのでそういうときどうなるのかな。

CL-USER> (winners #((1 2) (1 1) (1 1) (1 3)))
NIL
CL-USER>

むむむ。
先程の定義を見直します。

CL-USER> (defun winners (board)
           (let* ((tally (loop for hex across board ;ゲーム盤を走査し各マスの所有者のリストを
                              collect (car hex))) 
                  (totals (mapcar (lambda (player) ;マスを所有しているプレイヤーがいくつマスを
                                    (cons player (count player tally))) ;所有しているか
                                  (remove-duplicates tally)))
                  (best (apply #'max (mapcar #'cdr totals)))) ;一位のプレイヤーの所有マスの数
             (mapcar #'car                                    ;勝者のリストを作る
                     (remove-if-not (lambda (x) ;totalsからマスの所有数が1位タイでない
                                      (not (eq (cdr x) best))) ;プレイヤーの要素を除外
                                    totals))))
WINNERS
CL-USER>

tallyは(1 1 1 1)というリストになるはず。
totalsは…コンスセルのリストになるので、(1 . 4)。
bestは、当然4ですね。
...あ、remove-if-notじゃないのか。notとeqを使ってんだからそりゃそうだ。
修正して…再挑戦。

CL-USER> (play-vs-human (game-tree (gen-board) 0 0 t))
current player = a
  a-2 a-2 
 a-1 a-3 
The winener is a
NIL
CL-USER>

これはひどい。まあ、ちゃんとゲームが終了することは確認できたから運がいいのかな。

とりあえずここまで。今度は対戦相手を作ります。

Common Lispを頑張る(56)

2019年はいっぱい勉強します。頑張ります。
「Land of Lisp」のダイス・オブ・ドゥームの作成を続けます。

ゲーム盤を表現する部分は前に書きました。核となる部分に着手していきます。
そこでは関数型プログラミングテクニックの力を活用していくようです。
つまりゲーム盤の表現を含むデータの塊を受けとり、新たなゲーム盤の状態を返す
関数呼び出しの連鎖としてゲームを構築していきます。
そしてそれによりゲームルールエンジンは他の部分から完全に独立させることができます。
この手法の強力さを理解するためにまずはAIプレイヤーから作るようです。

と、実際に手を動かす前にこれから作る必要があるものについてもっとよく考えます。
まずは人間のターンを処理してくれる部分、AIのターンを処理する部分の2つは絶対に必要です。
2つは両方ともゲームのルールをその部分が理解してくれている必要があります。
つまり、ルールエンジンを作り、人間とAIのターンを司るものがそこにアクセスするようにすれば
ゲームエンジン部分は3個の大きな塊に綺麗に分離できるのではないでしょうか、
そして関数型プログラミングならその分離が綺麗に行えるようです。
ルールコードを遅延ゲームツリーとやらに展開することがそれが可能になるそうです、やった!
といいたいところですが、この章で作るゲームツリーはまだ遅延評価を使わないそう。
後々学んで実装するときにこの設計がもの凄いことを思いしるそうなのでお楽しみですね。

ゲームツリーの生成

ゲームのルールセットの全てを表現する関数がこちら。

CL-USER> (defun game-tree (board player spare-dice first-move)
           (list player
                 board
                 (add-passing-move board
                                   player
                                   spare-dice
                                   first-move
                                   (attacking-moves board player spare-dice))))
; in: DEFUN GAME-TREE
;     (ADD-PASSING-MOVE BOARD PLAYER SPARE-DICE FIRST-MOVE
;      (ATTACKING-MOVES BOARD PLAYER SPARE-DICE))
; 
; caught STYLE-WARNING:
;   undefined function: ADD-PASSING-MOVE

;     (ATTACKING-MOVES BOARD PLAYER SPARE-DICE)
; 
; caught STYLE-WARNING:
;   undefined function: ATTACKING-MOVES
; 
; compilation unit finished
;   Undefined functions:
;     ADD-PASSING-MOVE ATTACKING-MOVES
;   caught 2 STYLE-WARNING conditions
GAME-TREE
CL-USER>

…? 難しいなあ。
game-treeは、与えられた初期条件から全ての可能な指し手を表現する木構造を作るそう。
ああ、こんなことをするから最初のバージョンは2*2マスでの実装なんですかね。
引数は、盤面の状態、現在ターンのプレイヤー、現在のターンで獲得されたサイコロの数、
現在のプレイヤーのターンになってから行動したかどうか、の4つです。
プレイヤーが取れる手は2つ、ターンを終了するか、攻撃するか。
ターン終了はadd-passing-moveで、攻撃はattacking-movesです。
ターン終了するには最低一回は攻撃している必要あります。
だから攻撃の関数がターン終了の関数の中にあるんですかね。

それではターン終了の関数を見ていきます。

CL-USER> (defun add-passing-move (board player spare-dice first-move moves)
           (if first-move               ;もしターンの最初なら
               moves                    ;攻撃に入る
               (cons (list nil          ;手をゲームツリーに加える。ターン終了はnil
                           (game-tree (add-new-dice board player (1- spare-dice))
                                      (mod (1+ player) *num-players*)
                                      0
                                      t))
                     moves)))
; in: DEFUN ADD-PASSING-MOVE
;     (ADD-NEW-DICE BOARD PLAYER (1- SPARE-DICE))
; 
; caught STYLE-WARNING:
;   undefined function: ADD-NEW-DICE
; 
; compilation unit finished
;   Undefined function:
;     ADD-NEW-DICE
;   caught 1 STYLE-WARNING condition
ADD-PASSING-MOVE
CL-USER>

やっぱりよくわからないぞ。game-tree関数を再帰的に呼び出しているのはいいんですが…。
ああ、最後のmoveは、ターンを終了せずに再度攻撃した場合のゲームツリーを表現するのか。
ターン終了の関数とか言ってるのがよくない気がします。
参考書通り、「相手に手番を渡すという指し手をゲーム木に加える関数」と表現した方が理解できそう。
add-new-dice関数はターン終了時の盤面に更新するための関数ですね。未定義ですが。
その真下では次のプレイヤーに回すための処理ですね。プレイヤーが2人より多くなっても対応できます。

それでは「可能な攻撃の指し手をゲーム木に追加する関数」です。

CL-USER> (defun attacking-moves (board cur-player spare-dice)
           (labels ((player (pos)
                      (car (aref board pos))) ;引数番目のマスの所有プレイヤーを返す
                    (dice (pos)
                      (cadr (aref board pos)))) ;引数番目のマスのサイコロの数を返す
             (mapcan (lambda (src)              
                       (when (eq (player src) cur-player) ;引数のマスがプレイヤーのものなら
                         (mapcan (lambda (dst)
                                   (when (and (not (eq (player dst) cur-player))
                                              (> (dice src) (dice dst))) ;そして攻撃可能なら
                                     (list ;mapcanのためにリストにする
                                      (list (list src dst)
                                            (game-tree (board-attack board cur-player ;攻撃後の盤面の状態を
                                                                     src dst (dice src)) ;渡しているのだと思う
                                                       cur-player
                                                       (+ spare-dice (dice dst))
                                                       nil)))))
                                 (neighbors src)))) ;隣接するマスのリストを作っているのだろう
                     (loop for n below *board-hexnum*
                          collect n)))) ;全マスを走査
; in: DEFUN ATTACKING-MOVES
;     (BOARD-ATTACK BOARD CUR-PLAYER SRC DST (DICE SRC))
; 
; caught STYLE-WARNING:
;   undefined function: BOARD-ATTACK

;     (NEIGHBORS SRC)
; 
; caught STYLE-WARNING:
;   undefined function: NEIGHBORS
; 
; compilation unit finished
;   Undefined functions:
;     BOARD-ATTACK NEIGHBORS
;   caught 2 STYLE-WARNING conditions
ATTACKING-MOVES
CL-USER>

mapcanは確か返ってきたリストたちを一つのリストにまとめるのだったような。
mapcanが入れ子になっていますが、外側のもので全マスを走査して内側で1マス1マスの
隣接するマスを対象に攻撃可能か判定し攻撃可能なら攻撃後のゲームツリーを作るって感じですね。
ちょっととまどいました。複雑そうな関数を見るとひるんでしまう癖を直したいですね。

さ、今でた隣接するマスを見つける関数を書きます。

CL-USER> (defun neighbors (pos)
           (let ((up (- pos *board-size*)) ;対象のマスの上下を定義
                 (down (+ pos *board-size*)))
             (loop for p in (append (list up down)
                                    (unless (zerop (mod pos *board-size*)) ;posが左端でなければ
                                      (list (1- up) (1- pos))) ;左上と左側のマスを追加
                                    (unless (zerop (mod (1+ pos) *board-size*)) ;posが右端でなければ
                                      (list (1+ pos) (1+ down)))) ;右側と右下のマスを追加
                  when (and (>= p 0) (< p *board-hexnum*))
                  collect p)))          ;ゲーム盤に収まるマスを集めてリストにする
NEIGHBORS
CL-USER>

特につけ足すコメントはないですね。

攻撃を行う関数を書くとします。

CL-USER> (defun board-attack (board player src dst dice)
           (board-array (loop for pos from 0
                             for hex across board ;acrossは配列から値を取り出すためのもの
                             collect (cond ((eq pos src) (list player 1)) ;攻撃元ならサイコロ1個に
                                           ((eq pos dst) (list player (1- dice))) ;攻撃先なら攻撃元のサイコロ-1
                                           (t hex))))) ;それ以外ならそのまま
BOARD-ATTACK
CL-USER>

なんとか理解できます。ちょっと動かしてみます。

CL-USER> (draw-board #((0 3) (0 3) (1 3) (1 1)))
  a-3 a-3 
 b-3 b-1 
NIL
CL-USER> (board-attack #((0 3) (0 3) (1 3) (1 1)) 0 1 3 3)
#((0 3) (0 1) (1 3) (0 2))
CL-USER> (draw-board #((0 3) (0 1) (1 3) (0 2)))
  a-3 a-1 
 b-3 a-2 
NIL
CL-USER>

上で描写した状態からプレイヤーaで、右上から右下に攻撃を仕掛けました。
攻撃後の状態を描写したものが下のものなので、合っていますね。よしよし。

さて、あとはターンの終わりにサイコロを補給してくれる処理も必要です。
補給するためには、盤面を走査していき、ターンを終えようとしているプレイヤーのマスをみつけたら、
そのターン中に獲得したサイコロ-1個になるまで補給を続けるという処理が必要です。
つまり、補給している間は残りの補給可能数を記録しなくてはなりません。
手続き型に汚染された頭は、専用の変数を作り、補給をするたびにその数を減らす、
というようなことをまっ先に考えてしまいますが、それは関数型プログラミングスタイルではありえません。
それが封じられるとなると、再帰的に呼び出される関数を定義し、
引数に残り補給数を貰って減らして再帰するというような方法が次に思いつきますが、どうでしょう。

CL-USER> (defun add-new-dice (board player spare-dice)
           (labels ((f (lst n)
                      (cond ((null lst) nil) ;再帰の終了条件
                            ((zerop n) lst)  ;補給可能数が0なら何もしない
                            (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) spare-dice)))) ;配列で受け取った盤面をリストにし処理を行なう、最終的には配列で返す
ADD-NEW-DICE
CL-USER>

ふう、これでルールエンジンの部分は実装できた気がします。
続きの対戦のための部分はまた明日。

Common Lispを頑張る(55)

新年あけましておめでとうございます。今年もよろしくお願いいたします。
それではやります。「Land of Lisp」15章、ダイス・オブ・ドゥームというゲームを作ります。

ダイス・オブ・ドゥーム

ルール

ゲームが発展していくにつれルールも難しくなるようですが、とりあえず最初のバージョンのルールです。
・プレイヤーは2人。六角形の升目のゲーム盤上でそれぞれ陣地を持ってスタート。
・各升目には、その陣地を所有するプレイヤーが六面サイコロをいくつか置く。
・プレイヤーは自分のターン中何回でも手を重ねていいが、最低1回は行動しなくてはいけない。
・どちらかのプレイヤーに指せる手が無くなった時点でゲーム終了。
・指す手は、隣合う的の陣地を攻撃すること。攻撃側の陣地にあるサイコロの数の方が多ければ攻撃可能。
・攻撃後の戦闘の勝敗は、現バージョンでは常に攻撃側の勝利とする。
・戦闘後、敗者のサイコロはマスから取り除かれ、勝者のマスにあったサイコロは1個を除き、奪ったマスに移動する。
・ターンの終了時、そのプレイヤーの軍に補給が行なわれる。
一番左上から右へ、その次の行の左から右へ、 というようにサイコロを1つずつ足していく。
足せるサイコロの数はそのターン、相手から奪ったサイコロの数マイナス1個。
・ゲーム終了時により多くのマスを所有していたプレイヤーの勝利。

バージョン1の実装

このゲームは関数型プログラミングで実装されます。つまり、清浄な関数型コードと
不浄な命令型コードから構築されるはずです。その2つの区別を明確にしながら進めてくれるそう。

まずは基本情報を保持するためのグローバル変数を定義。

CL-USER> (defparameter *num-players* 2)
*NUM-PLAYERS*
CL-USER> (defparameter *max-dice* 3)
*MAX-DICE*
CL-USER> (defparameter *board-size* 2)
*BOARD-SIZE*
CL-USER> (defparameter *board-hexnum* (* *board-size* *board-size*))
*BOARD-HEXNUM*
CL-USER>

ゲーム盤はリストで表現します。一番左上のマスが始点です。
そして各六角マスにあたるリストの要素に、マスの占有者、その場所にあるサイコロの数の情報を持たせます。
左上から、「プレイヤー1のマス・サイコロ2個、プレイヤー2のマス・サイコロ2個、
プレイヤー1のマス・サイコロ3個、プレイヤー1のマス・サイコロ1個」となっていた場合、

((0 2) (1 2) (0 3) (0 1))

と表わせるわけですね。自分の理解の確認のために詳しくやりすぎました。

で、今は2*2のゲーム盤だからいいような気がしますが、このゲーム盤のリストを配列でも
表わせるようにしておいた方が後々いいことになる気がします。
リスト後部へのアクセスの効率が悪いことは周知の事実ですね。
リストで表現されたゲーム盤を配列表現へと変換する関数を作成します。

CL-USER> (defun board-array (lst)
           (make-array *board-hexnum* :initial-contents lst))
BOARD-ARRAY
CL-USER>

これは清浄な関数ですね。よしよし。

ゲーム開始時にゲーム盤をランダムに初期化するための関数も作りましょう。

CL-USER> (defun gen-board ()
           (board-array (loop for n below *board-hexnum*
                             collect (list (random *num-players*)
                                           (1+ (random *max-dice*))))))
GEN-BOARD
CL-USER>

不浄ですね。randomとかいうやつがいます。
しかしこれ運が悪いとゲーム開始時に陣地を貰えないプレイヤーでませんかね。
とりあえず現時点で想定通りに動くか確認してみます。

CL-USER> (gen-board)
#((1 3) (0 1) (1 2) (0 2))
CL-USER> (gen-board)
#((1 3) (1 2) (0 2) (1 2))
CL-USER> (gen-board)
#((1 2) (1 3) (1 3) (1 3))
CL-USER>

…まあ、ちゃんと動いています。

0とか1とかはプレイヤーを区別するためのものとして優しくないので文字に変換できるようにします。

CL-USER> (defun player-letter (n)
           (code-char (+ 97 n)))
PLAYER-LETTER
CL-USER> (mapcar 'player-letter '(0 1))
(#\a #\b)
CL-USER>

code-charはASCIIコードを該当する文字に変換してくれるそう。ここも清浄ですね。

さて、配列を受け取って画面に綺麗に表示してくれる関数も欲しいです。
マスは六角形なのでちょっとずらして隣接するマスがわかりやすいとグッドですね。

CL-USER> (defun draw-board (board)
           (loop for y below *board-size* ;行数分の繰り返し
                do (progn (fresh-line)    ;まずは改行
                          (loop repeat (- *board-size* y) ;行ごとにずれるように
                               do (princ " "))
                          (loop for x below *board-size* ;列数分の繰り返し
                             for hex = (aref board (+ x (* *board-size* y))) ;対象のマスの要素を取り出す
                             do (format t "~a-~a " (player-letter (first hex))
                                        (second hex))))))
DRAW-BOARD
CL-USER>

画面への表示のための関数なので言うまでもありませんが不浄です。さて試してみます。

CL-USER> (draw-board #((1 3) (1 2) (0 2) (1 2)))
  b-3 b-2 
 a-2 b-2 
NIL
CL-USER>

うまいこと動いてくれている感じですね。

ここまででゲーム盤関連の箇所は完成のよう。
キリがいいようなので一旦ここで切ることにします。