Haskellで将棋 - 指し手生成部を少しずつ改良していく
今回は、指し手生成部を２つの関数に分解する。
現在は指し手生成を駒を移動する手と持ち駒を打つ手に分けて生成しているが、これをさらに分解して
- 駒を打つ手
- 駒を移動する手のうち取る手
- 駒を移動する手のうち取らない手
に分解していきたい。正確に言うと以下の参考資料通り
2009-11-08 - Bonanzaソース完全解析ブログ
手によって評価値が大きく変化する場合、変化しない場合を場合分けして部分生成しつつゲーム木を探索することで無駄な手生成を抑えながらスピードアップを図れる構造にしていきたい。
というわけで、現在のジャイガンティックな手生成関数を少しずつ分解していく。
Giganticな手生成関数
mvGenFull :: Board.Bd -> [Move.Mv] mvGenFull bd = allInNoCheck bd ++ dropMvs bd allInNoCheck :: Board.Bd -> [Move.Mv] allInNoCheck (Board.Bd sqs _ me _ pcl) = concatMap pcsMvs $ Board.sidePcl me pcl where pcsMvs :: (Piece.Pc, [Piece.Pos]) -> [Move.Mv] pcsMvs (pc, pcsqs) = concatMap pcMvs pcsqs where pcMvs fr = concatMap (incMvs fr) (Piece.pcIncs pc) where -- Attempts move from cur to the direction of inc (one step) incMvs cur inc = case cap of Piece.Empty -> mvAdd ++ -- For HI/KA/KY, needs to re-attempt for the direction Util.if' (Piece.isSlider pc inc, incMvs to inc, []) Piece.Wall -> [] otherwise -> if Piece.co cap == me then [] else mvAdd where to = cur + inc cap = sqs ! to mvAdd = -- Move and promotion, capture if possible Util.if' (canPro pc fr to, (Move.Mv fr to pc cap True :), id) -- Move and NO promotion, capture if possible $ Util.if' (canNoPro pc fr to, [Move.Mv fr to pc cap False], [])
現在のコマの移動による手の生成を行う関数は以上のようになっている。大きい関数だ。駒を打つ手は省略している。
これを分解していきたい。
まずはallInNoCheckだが、基本的にはpcsMvsとpcMvsは型を合わせるためにconcatMapしているだけの関数だ。concatMapは(concat .) . mapな関数で、単にリストの要素ひとつひとつからリストを作り出す関数をリストに適用してflattenするだけだ。この場合、リストの要素ひとつひとつはある駒になっていて、駒から移動先Moveを作り出す関数を駒のリストに適用すると移動先のリストのリストができるので、これを全部平らにするだけ。
incMvsはその駒から移動先Movesのリストを作り出す関数だ。ある駒にincMvsを適用すると、そのボードの上で移動できるすべての場所をリストアップする。非合法手も含めて生成するのでこの部分は何らかの対策が必要だが、いまは無視する。
つまり、incMvsだけ切り離してしまえばよい。
incMvsを切り離す
mvGenFullN :: Board.Bd -> [Move.Mv] mvGenFullN bd = (allInNoCheckN bd mvAddCaptures) ++ (allInNoCheckN bd mvAddNoCaptures) ++ dropMvs bd {- Move from cur to the direction of inc. - Returns the possible motion from cur to inc - from and cur needs to be same. -} incMvs :: Piece.Co -> Piece.Pc -> Board.Sqs -> Piece.Pos -> Piece.Pos -> (Piece.Pc -> Piece.Pos -> Piece.Pos -> Piece.Pc -> [Move.Mv]) -> Piece.Pos -> [Move.Mv] incMvs me pc sqs from cur mvAdd inc = case cap of Piece.Empty -> (mvAdd pc from to cap) ++ -- For HI/KA/KY, needs to re-attempt for the direction Util.if' (Piece.isSlider pc inc, incMvs me pc sqs from to mvAdd inc, []) Piece.Wall -> [] _ -> if Piece.co cap == me then [] else (mvAdd pc from to cap) where to = cur + inc cap = sqs ! to mvAddNoCaptures :: Piece.Pc -> Piece.Pos -> Piece.Pos -> Piece.Pc -> [Move.Mv] mvAddNoCaptures pc from to cap = case cap of Piece.Empty -> Util.if' (canPro pc from to, (Move.Mv from to pc cap True :), id) $ Util.if' (canNoPro pc from to, [Move.Mv from to pc cap False], []) Piece.Wall -> [] _ -> [] mvAddCaptures :: Piece.Pc -> Piece.Pos -> Piece.Pos -> Piece.Pc -> [Move.Mv] mvAddCaptures pc from to cap = case cap of Piece.Empty -> [] Piece.Wall -> [] _ -> Util.if' (canPro pc from to, (Move.Mv from to pc cap True :), id) $ Util.if' (canNoPro pc from to, [Move.Mv from to pc cap False], []) allInNoCheckN :: Board.Bd -> (Piece.Pc -> Piece.Pos -> Piece.Pos -> Piece.Pc -> [Move.Mv]) -> [Move.Mv] allInNoCheckN (Board.Bd sqs _ me _ pcl) method = concatMap pcsMvs $ Board.sidePcl me pcl where -- Generate moves from the pair of piece and list of positions pcsMvs :: (Piece.Pc, [Piece.Pos]) -> [Move.Mv] pcsMvs (pc, pcsqs) = concatMap pcMvs pcsqs where -- Get destinations by from and piece pcMvs :: Piece.Pos -> [Move.Mv] pcMvs fr = concatMap (incMvs me pc sqs fr fr method) (Piece.pcIncs pc)
名前は適当につけてみた。こういうのはほんとうに良くない。現状のソースはシンボルの名前が全て適当なので後で全て付け直す予定。
短い名前が多すぎて頭がくらくらする。aとかfとかgとか名前とは言わない。略称も本当は良くない。MvsではなくMovesだしgenはgenerateとするべきだろう。Haskell方面の人は短い名前が好きなんだろうか。BonanzaのソースにあるGenCapturesも本当はGenerateMovesOfCapturesとするべきだと思う。IDEの支援がないと長い名前は難しいけれども。
閑話休題。もとのallInNoCheckはincMvsをごっそり抜き出したのでそこそこ短くなった。
incMvsはmvAddを差し替えられるように関数で受け取るようにした。骨組みの部分は変わっていない。
mvAddCapturesとmvAddNoCapturesはもとのmvAddsの部分にあった条件式をそのまま利用している。それを移動先にある駒/空きを表すcapの状態によって切り替えているだけだ。
テストを書く
簡単なテストを書いて自信をつけておく。mvGenFullとmvGenFullNがあるので、出力が変化しないことを確かめる。本当に簡単なテストを書いてみた。本来はもっとたくさんの盤面でテストをするべきだが、時間がないので簡単に済ませてしまった。
Test for move generation (very simple)
これを実行すると、出力は
$
board is now
WL WN WL turn => W
BP+ WG WK stage => 0
WN WL BS
WP WP BP WP
BP BS WP
BP BP WB BP BP
BP BK BS
BR Bhand => BG 1 BR 1
BL BN WB BK BL Whand => WP 5 WN 1 WS 1 WG 1
(BP ,[96,109,124,125,129,131,140])
(BL ,[174,182])
(BN ,[175])
(BS ,[77,112,147])
(BR ,[157])
(BK ,[146,181])
(BP+,[60])
(WP ,[89,91,97,113])
(WL ,[38,46,75])
(WN ,[45,74])
(WG ,[62])
(WB ,[126,180])
(WK ,[63])
[P*81,N*81,S*81,G*81,N*71,S*71,G*71,P*61,N*61,S*61,G*61,P*51,N*51,S*51,G*51,P*41,N*41,S*41,G*41,P*31,N*31,S*31,G*31,N*92,S*92,G*92,P*82,N*82,S*82,G*82,N*72,S*72,G*72,P*62,N*62,S*62,G*62,P*52,N*52,S*52,G*52,P*32,N*32,S*32,G*32,N*93,S*93,G*93,P*83,N*83,S*83,G*83,P*53,N*53,S*53,G*53,P*33,N*33,S*33,G*33,N*23,S*23,G*23,N*13,S*13,G*13,P*84,N*84,S*84,G*84,P*64,N*64,S*64,G*64,P*54,N*54,S*54,G*54,P*44,N*44,S*44,G*44,P*34,N*34,S*34,G*34,N*95,S*95,G*95,P*85,N*85,S*85,G*85,N*75,S*75,G*75,P*55,N*55,S*55,G*55,P*45,N*45,S*45,G*45,N*15,S*15,G*15,N*96,S*96,G*96,P*56,N*56,S*56,G*56,P*46,N*46,S*46,G*46,N*26,S*26,G*26,P*87,N*87,S*87,G*87,N*77,S*77,G*77,P*67,N*67,S*67,G*67,P*57,N*57,S*57,G*57,P*47,N*47,S*47,G*47,N*17,S*17,G*17,P*88,S*88,G*88,S*78,G*78,P*68,S*68,G*68,P*58,S*58,G*58,P*48,S*48,G*48,P*38,S*38,G*38,S*28,G*28,S*18,G*18,S*79,G*79,S*69,G*69,S*59,G*59,S*49,G*49,92WL (91),93WL (91),33WN (21),13WN (21),32WG (22),33WG (22),23WG (22),13WG (22),23WK (12),13WK (12),85WN (73),65WN (73),64WL (63),65WL (63),95WP (94),75WP (74),15WP (14),26WP (25),93WB (66),33WB (66),84WB (66),44WB (66),75WB (66),55WB (66),77WB (66)+,57WB (66)+,88WB (66)+,48WB (66)+,99WB (66)+,57WB (39)+,17WB (39)+,48WB (39)+,28WB (39)+]
...
[P*81,N*81,S*81,G*81,N*71,S*71,G*71,P*61,N*61,S*61,G*61,P*51,N*51,S*51,G*51,P*41,N*41,S*41,G*41,P*31,N*31,S*31,G*31,N*92,S*92,G*92,P*82,N*82,S*82,G*82,N*72,S*72,G*72,P*62,N*62,S*62,G*62,P*52,N*52,S*52,G*52,P*32,N*32,S*32,G*32,N*93,S*93,G*93,P*83,N*83,S*83,G*83,P*53,N*53,S*53,G*53,P*33,N*33,S*33,G*33,N*23,S*23,G*23,N*13,S*13,G*13,P*84,N*84,S*84,G*84,P*64,N*64,S*64,G*64,P*54,N*54,S*54,G*54,P*44,N*44,S*44,G*44,P*34,N*34,S*34,G*34,N*95,S*95,G*95,P*85,N*85,S*85,G*85,N*75,S*75,G*75,P*55,N*55,S*55,G*55,P*45,N*45,S*45,G*45,N*15,S*15,G*15,N*96,S*96,G*96,P*56,N*56,S*56,G*56,P*46,N*46,S*46,G*46,N*26,S*26,G*26,P*87,N*87,S*87,G*87,N*77,S*77,G*77,P*67,N*67,S*67,G*67,P*57,N*57,S*57,G*57,P*47,N*47,S*47,G*47,N*17,S*17,G*17,P*88,S*88,G*88,S*78,G*78,P*68,S*68,G*68,P*58,S*58,G*58,P*48,S*48,G*48,P*38,S*38,G*38,S*28,G*28,S*18,G*18,S*79,G*79,S*69,G*69,S*59,G*59,S*49,G*49,92WL (91),93WL (91),33WN (21),13WN (21),32WG (22),33WG (22),23WG (22),13WG (22),23WK (12),13WK (12),85WN (73),65WN (73),64WL (63),65WL (63),95WP (94),75WP (74),15WP (14),26WP (25),93WB (66),33WB (66),84WB (66),44WB (66),75WB (66),55WB (66),77WB (66)+,57WB (66)+,88WB (66)+,48WB (66)+,99WB (66)+,57WB (39)+,17WB (39)+,48WB (39)+,28WB (39)+]
...
:newMoveValidation: [OK]
Test Cases Total
Passed 1 1
Failed 0 0
Total 1 1
こんな感じ。
まとめ
ここまでやってみたが、現状のところ足りないのは:
- 合法手の判定（実際に対戦させてみるとすぐ自殺手を打って負けてしまう）
- 回避手（Bonanzaでevasionと呼ばれている王手から逃れる手）
だが、基本的にソースコードの見通しが悪く、なかなかモチベーションが上がらない。ここでソースコードを綺麗にするためにビットボードを導入してみたい。
現代の将棋プログラムといえばビットボード。ビットボードにあらずば人にあらずといった感じである。幸いつい先日オセロをビットボードで実装するのを終えたばかりなので、なんとなく雰囲気はわかっているつもり。なので、Haskellでビットボードを使ってみたい。Haskellでビット操作といえばData.Bitsだ。大工事になるので楽しみだ。
