読者です 読者をやめる 読者になる 読者になる

euphonictechnologies’s diary

Haskell超初心者の日記です。OCamlが好きです。

follow us in feedly

Haskellで将棋 - 指し手生成部を少しずつ改良していく

Haskell コンピュータ将棋

今回は、指し手生成部を2つの関数に分解する。

現在は指し手生成を駒を移動する手と持ち駒を打つ手に分けて生成しているが、これをさらに分解して

  • 駒を打つ手
  • 駒を移動する手のうち取る手
  • 駒を移動する手のうち取らない手

に分解していきたい。正確に言うと以下の参考資料通り

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だが、基本的にはpcsMvspcMvsは型を合わせるために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の支援がないと長い名前は難しいけれども。

閑話休題。もとのallInNoCheckincMvsをごっそり抜き出したのでそこそこ短くなった。

incMvsmvAddを差し替えられるように関数で受け取るようにした。骨組みの部分は変わっていない。

mvAddCapturesmvAddNoCapturesはもとのmvAddsの部分にあった条件式をそのまま利用している。それを移動先にある駒/空きを表すcapの状態によって切り替えているだけだ。

テストを書く

簡単なテストを書いて自信をつけておく。mvGenFullmvGenFullNがあるので、出力が変化しないことを確かめる。本当に簡単なテストを書いてみた。本来はもっとたくさんの盤面でテストをするべきだが、時間がないので簡単に済ませてしまった。

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だ。大工事になるので楽しみだ。