Haskellのパワーはなんといっても遅延評価。Ocamlから移ってきた私としては一番戸惑うのはその部分で、末尾最適化への気の払い方とかが若干違ってくる気がします。なんというか、foldl'と比べてfoldrなら必要な部分しか評価されないから無限リストも処理できるし効率もいいですよ…ほんとか？みたいな。Welcome to the world of laziness!
optimization - foldl is tail recursive, so how come foldr runs faster than foldl? - Stack Overflow
How Lazy Evaluation Works in Haskell | HackHands
とはいえ、この遅延処理が多用されるのがゲーム木探索のようで将棋プログラムに何故coroutineが必要なのか - Bonanzaソース完全解析ブログで言われていることと密接に関係してきます。コルーチンで表現されるような一連の結果のリストを必要な部分だけ取ってきて使う、みたいな。
たとえば3手詰め関数を考えるときに、3手詰め開始局面からすべての指し手を一度に生成する必要はありません。一つ局面を生成してその手から詰みが見つかれば他の局面は一切必要ないからです。なので、手を1つずつとって
while( hand = 一手取り出す ) {
handから詰みを探索
if 詰みが見つかった then break
}
という感じかな?一手取り出す関数は当然参照透過ではなく、全く同じ引数なのに呼び出すたびに新しい手を生成します（当然引数に状態を保存すれば一手取り出す関数自体は参照透過です）。この部分を
foldr <いままでfalseなら、詰みを探索。その手から詰みが見つかったらtrueで一度trueになったらもう指し手は全く使わないでtrueを返す> <最初はfalse> <3手詰め開始局面からのすべての指し手のリスト>
とすると3手詰め開始局面からのすべての指し手のリストは部分的に評価され、指し手が生成されますが、他に関してはプロミスの状態でほっておかれます。
今回はこんな感じでゲーム木探索をするロジックを実装して現状のSearch.minmax関数を置き換えます。
現状のminmaxはこれ
minmax :: Int -> Board.Bd -> Result minmax 0 bd = Result (Eval.eval bd) [] minmax dep bd = maximumBy (compare `on` va) nexts where nexts = map next $ MoveGenerator.mvGenFull bd next mv = conv mv . minmax (dep - 1) $ Board.bdDo bd mv
今回の参考文献
(Why Functional Programming Matters)
この中の"5. 人工知能からの例"を実装していきます。この論文のプログラムはMirandaで書かれている。MirandaはHaskellの祖先なのですごく構文は似通っているから簡単にインプリできそう。
まずミニマックス法を実装する。
ゴールはこれ
evaluate = maximise . maptree static . gametree
わかりやすくすると
minmax board = (maximise . maptree evaluateBoard . gametree) board
という感じ。boardを引数にとってminmaxした後に最大になるpvの評価値の値を返す関数。
まずgametreeは
gametree p = reptree moves p
という感じに局面をひとつ受け取ってそこからゲーム木を作り出す関数。ここでmovesは局面pから指し手を生成して、その指し手を適用した後の局面のリストを返す関数。reptreeは
reptree f a = node a (map (reptree f) (f a))
となっている。これは無限に再帰してしまう。ここで先程述べた遅延評価のパワーが発揮される。reptreeはあるノードの子ノードをどんどん展開していく関数になっている。
次にmaptreeだが、これはリストに対するmapのようにツリーのすべてのノードにある関数を適用してそのツリーを得る関数。たとえば局面のツリーにevaluateBoardを適用して評価値のツリーを得る。
これはmapがfoldr(論文ではreduce)で実装されているようにmaptreeはredtreeで実装する。まず、mapは
map f = foldr ((:) . f) []
である。結果を格納する空リストに対してfを適用したリストの要素を次々つないでいくというfor-each的な発想で、割と素直に理解できる。foldrはリストのcons(:)を別の関数で置き換えて、空リストを別の要素で置き換える事によって実現される。この考え方をツリーにも生かしていく。つまり、maptreeは
maptree f = redtree (Node . f) (:) []
になりそうだ。本当にmapと素直に対応する。
ここでNodeは
data Tree n = Node {node :: n, childNodes :: [Tree n]} deriving (Show)
というツリーのデータ構築子になっている。
redtreeは親ノードと子ノードをつなぐ部分を置き換える関数、子ノード同士(siblings)の間のcons(:)を置き換える関数、そして空の子供を置き換える関数によって実現されるはずだ。つまり、redtreeは適用するツリーと先に上げた3つの置き換え要素を含めて4つの引数をとる。
{- - f - function to replace Node - g - function to replace Cons - a - something to replace Nil -} redtree :: (t -> t1 -> t2) -> (t2 -> t1 -> t1) -> t1 -> Tree t -> t2 redtree f g a Node {node = n, childNodes = c} = f n (redtree' f g a c) redtree' f g a (hd : rest) = g (redtree f g a hd) (redtree' f g a rest) redtree' f g a [] = a
となる。redtreeはツリーを処理する。redtree'は子ノードのリストを処理するこの2つの関数を行ったり来たりして処理が進む。
maptreeが手に入ればあとはmaximiseを実装すれば良い。maximiseはminmaxなので子ノードのそのまた子供の部分がminimiseされたあとのリストから最大のものを取る。minimiseはvice versa.説明するよりコードをみるほうが早いかもしれない。
maximize Node {node = n, childNodes = []} = n
maximize Node {node = _, childNodes = c} = maximum (map minimize c)
minimize Node {node = n, childNodes = []} = n
minimize Node {node = _, childNodes = c} = minimum (map maximize c)
こんな感じ。お互いに相互に呼び出して、最果てでは空リストに対する処理で閉じている。おかげで無限の再帰構造にならない。
すべてまとめて
evaluate = maximise . maptree static . gametree
となる。ただ、このままだと永遠に手を生成していくので将棋方程式の答えを得た時かメモリがあふれた時まで止まらない。なん手先まで深く読むかを決めるprune関数を組み込もう。
prune 0 Node {node = n, childNodes = _} = Node n [] prune r Node {node = n, childNodes = c} = Node n $ map (prune (r - 1)) c
こんな感じ。割と素直に理解できることと思う。深さrを1つずつ減らしていって0になったら子ノードをなかったことにする。
すべてをまとめると
-- minmax method evaluate = maximize . maptree Eval.eval . (prune 3) . gametree
となる。3手読みにしている。Eval.evalは前に紹介した私のプログラムの評価関数だ。fv.binを使用している。これでミニマックス法ができあがり。
これをアルファベータ法にする
アルファベータ法のゴールは
alphabeta = maximum . maximize' . highfirst . maptree Eval.eval . (prune 3) . gametree
である。新しい関数はmaximize'とhighfirstだ。ミニマックス法と比べるとmaximize = maximum . maximize'と分解されている。maxmize'はベータカットをする関数。highfirstは指し手を良い順に並べ替えてなるべくベータカットを引き起こすための関数になっている。maximize'をみてみると
maximize' Node {node = n, childNodes = []} = n : []
maximize' Node {node = _, childNodes = c} = mapmin (map minimize' c)
minimize' Node {node = n, childNodes = []} = n : []
minimize' Node {node = _, childNodes = c} = mapmax (map maximize' c)
のように、maximize'はこのようにすぐ上で定義したmaximizeとよく似ている。違いはmapminとmapmaxの部分だけ。
mapminとmapmaxはアルファベータ法なので、兄弟ノードのうち未評価のものがある状態でもう評価しなくてもいいかどうかを考慮してminとかmaxとかを返してくれる関数になっている。
ここで遅延評価のパワーを使う。リストの先頭から順番に評価していって残りの数がどうなってももうこの兄弟ノードの最大値、または最小値が変化しなくなったらリストの残りの評価をしないような関数にすれば良いので、リストの残りを評価する必要があるか判断する関数omitを使うと
mapmin (nums : rest) = (minimum nums) : (omitmin (minimum nums) rest) mapmax (nums : rest) = (maximum nums) : (omitmax (maximum nums) rest)
という感じになる。numsはとある子ノードのすべての孫ノードの評価値のリストになっている。restは他の孫ノードの評価値のリストのリストになっている。omitminとomitmaxは
omitmin pot [] = [] omitmin pot (nums : rest) | minleq nums pot = omitmin pot rest | otherwise = (minimum nums) : (omitmin (minimum nums) rest) minleq [] pot = False minleq (num : rest) pot | num <= pot = True | otherwise = minleq rest pot omitmax pot [] = [] omitmax pot (nums : rest) | maxgeq nums pot = omitmax pot rest | otherwise = (maximum nums) : (omitmax (maximum nums) rest) maxgeq [] pot = False maxgeq (num : rest) pot | num >= pot = True | otherwise = maxgeq rest pot
という感じ。minleqやmaxgeqはヘルパー関数になっていて、いままで見つけた今のところの最小値、もしくは最大値potに対してリストの中に一つでも小さい、あるいは大きい物があればTrueを返す。これを使うとomitminは今のところの候補最小値とリストのリストを受け取って新しい孫たちが最小値を書き換える場合は切り捨てることができる。そうでない場合は(minimum nums)を評価することで指し手の生成、評価値の計算を行う。そうすると最大化ができている(minleqが等号も含めているのはminleqはmaximize'に対応するため。minleqならばベータカットだ。)
遅延はこの部分で行われていて、実際の子ノードの最小値・最大値を求めるmaximum numsがサンクを引き起こす。
これでアルファベータ法自体は閑静だが、先に述べたように指し手を並べ替えて効率よくベータカットされるようにしたい。
highfirst Node {node = n, childNodes = c} = Node n (sortBy (comparing node) (map lowfirst c))
lowfirst Node {node = n, childNodes = c} = Node n (sortBy (flip $ comparing node) (map highfirst c))
これは普通のソートだ。comparingは関数と2つの比較対象をとってその関数を2つの比較対象に適用した後の比較Ordを返す。この場合はノードからノードのラベルである評価値だけを引き抜いてソートしている。
最後にまとめると
-- alphabeta alphabeta = maximum . maximize' . highfirst . maptree Eval.eval . (prune 3) . gametree
となる。参考文献にはこの後さらにpruneにdynamic関数を組み込んで固定深さ探索から、動的に深さを変えることを書いてある。この部分はまた後でrevisitすることにしたい。
早速実行してみる
ユニットテストに次のコードを追加して実行してみるとアルファベータ法が実行できる。局面は前回の指し手生成スピードの測定に使った局面を使っている。
alphabetaTest = do let board = Usi.bdFromSfen [ "l6nl/5+P1gk/2nl1S3/p1p4Pp/3P2Sp1/1PPb2P1P/P5GS1/R8/LN4bKL", "w", "GR5pnsg" ] printf "board is now\n" print board printf "\n" print "start searching by alphabeta..." print "done. val is" let val = IS.alphabeta board print val
これをプロファイラで実行してそれぞれの関数の呼び出し回数を見てみると
individual inherited
"Running test ..."
MAIN MAIN 114 0 0.0 0.0 100.0 100.0
fvbin Eval 928 0 0.0 0.0 0.0 0.0
alphabetaTest Main 231 0 0.0 0.0 0.0 0.0
main Main 229 0 0.0 0.0 0.0 0.0
CAF Main 227 0 0.0 0.0 100.0 100.0
alphabetaTest Main 230 1 0.0 0.0 100.0 100.0
alphabetaTest.val Main 367 1 0.0 0.0 100.0 100.0
alphabeta Internal.Search 369 0 0.0 0.0 100.0 100.0
maximize' Internal.Search 377 4312 0.0 0.0 0.0 0.0
minimize' Internal.Search 1000 718066 0.0 0.0 0.0 0.0
mapmax Internal.Search 1007 205 0.0 0.0 0.0 0.0
omitmax Internal.Search 1012 4116 0.0 0.0 0.0 0.0
maxgeq Internal.Search 1013 165295 0.0 0.0 0.0 0.0
mapmin Internal.Search 999 4312 0.0 0.0 0.0 0.0
omitmin Internal.Search 1010 714045 0.0 0.0 0.0 0.0
minleq Internal.Search 1011 894200 0.0 0.0 0.0 0.0
prune Internal.Search 376 802053 0.1 0.0 0.1 0.0
gametree Internal.Search 374 1 0.0 0.0 1.8 0.5
reptree Internal.Search 375 802053 0.0 0.0 1.8 0.5
moves Internal.Search 379 4517 0.1 0.0 1.7 0.5
moves.\ Internal.Search 479 802052 0.1 0.0 1.2 0.3
bdModify Board 481 802052 0.0 0.0 0.0 0.0
bdDo Board 480 802052 0.1 0.0 1.1 0.3
unpPc Piece 922 17904 0.0 0.0 0.0 0.0
pcOppCo Piece 921 17904 0.0 0.0 0.0 0.0
co Piece 926 17904 0.0 0.0 0.0 0.0
oppEn Util 923 0 0.0 0.0 0.0 0.0
modiEn Util 924 0 0.0 0.0 0.0 0.0
fromEnum Piece 925 17904 0.0 0.0 0.0 0.0
|+> Util 575 154917 0.0 0.0 0.0 0.0
oppEn Util 510 0 0.0 0.0 0.0 0.0
modiEn Util 511 0 0.0 0.0 0.0 0.0
fromEnum Piece 512 802052 0.0 0.0 0.0 0.0
bdDo.tPc Board 498 155326 0.0 0.0 0.0 0.0
pcOppPro Piece 929 37379 0.0 0.0 0.0 0.0
pro Piece 936 37379 0.0 0.0 0.0 0.0
oppEn Util 933 0 0.0 0.0 0.0 0.0
modiEn Util 934 0 0.0 0.0 0.0 0.0
fromEnum Piece 935 37379 0.0 0.0 0.0 0.0
|+> Util 499 155326 0.0 0.0 0.0 0.0
if' Util 497 155326 0.0 0.0 0.0 0.0
という感じ。movesは指し手生成をして局面を展開する関数だが、4517回となっている。ベータカットのお陰で5手深さよみにも関わらず4517回の局面展開ですんでいる。
まとめ
今回は遅延評価のパワーを使って指し手を部分的に生成しつつベータカットをしていくロジックを実装できました。ただ、あまりに遅いので、ここをどうにかしていきたいけど、何から手を付けようかと考えているところ…。
Real World Haskell―実戦で学ぶ関数型言語プログラミング
- 作者: Bryan O'Sullivan,John Goerzen,Don Stewart,山下伸夫,伊東勝利,株式会社タイムインターメディア
- 出版社/メーカー: オライリージャパン
- 発売日: 2009/10/26
- メディア: 大型本
- 購入: 8人 クリック: 245回
- この商品を含むブログ (76件) を見る
あわせてこれも Real World Haskell の古いところ - あどけない話