二人零和有限確定完全情報ゲーム

タイトル、のようなゲームには必勝法が存在する。
そのこと自体は直感的にも理解できるし、証明も簡単だろう。
さらには最善手も非常に簡単なアルゴリズムで計算できる。

が、計算できるものと現実的に計算できるものの間には
大きな開きがあり、現実的に計算できるもの、というのは
きわめて大雑把にPといわれる計算複雑性クラスに入るもの
に限られてしまう、ということも周知の事実であろう。

そういうことなのであるが、あえてそれを無視してみる。
要するに上記で非常に簡単なアルゴリズム、と書いたものを
抽象的なゲームに対して定義しようかとそんなわけである。
非常に規模の小さいゲームについては利用できるかもしれない。

ここでは○×ゲームを題材にすることにする。
また、アルゴリズムは単にand-or木を全探索するだけとする。
and-or木にはalpha-beta探索というきわめて重要な
枝狩りテクニックがあるのだが、ひとまずそれは無視して。
さらに、先ほど抽象的な…と書いたが、いきなりそれは私には少々
荷が重いので、まずは具体的なプログラムを作ってみる。

import Data.List
import Data.Char

data Elem  = Maru | Batsu | Blank deriving (Eq,Show)
type Board = (Bool,Elem)
type Hand  = (Int,Int)

bestHand :: Board -> Hand
bestHand bd = snd $ maximumBy (\x y -> andOr bd (fst x) (fst y))
                      [(f nb,h) | (nb,h) <- successor bd] where
  f bd | null sbd  = evalBoard bd
       | otherwise = maximumBy (andOr bd) [f b| (b,_) <- sbd]
    where sbd = successor bd

evalBoard :: Board -> Int
evalBoard (teban,bd)
  | or [and [bd!!y!!x == Maru  | (x,y) <- l] | l <- line] = 1
  | or [and [bd!!y!!x == Batsu | (x,y) <- l] | l <- line] = -1
  | otherwise = 0
  where
    line =
      [[(0,0),(1,0),(2,0)],[(0,1),(1,1),(2,1)],[(0,2),(1,2),(2,2)]
      ,[(0,0),(0,1),(0,2)],[(1,0),(1,1),(1,2)],[(2,0),(2,1),(2,2)]
      ,[(0,0),(1,1),(2,2)],[(2,0),(1,1),(0,2)]]

successor :: Board -> [(Board,Hand)]
successor b@(teban,bd)
  | evalBoard b /= 0 = []
  | otherwise =
    [ ( (not teban,updt x y nel bd),(x,y))
    | (l,y) <- zip bd [0..], (d,x) <- zip  l [0..], d==Blank]
  where nel = if teban then Maru else Batsu

updt x y v bd = f y (f x v (bd!!y)) bd where
  f 0 v (_:xs) = v:xs
  f n v (x:xs) = x:f (n-1) v xs

endGame = null . successor

andOr :: Board -> Int -> Int -> Ordering
andOr (True ,_) = compare
andOr (False,_) = flip compare

initBoard = (True,replicate 3 $ replicate 3 Blank)

move :: Hand -> Board -> Board
move (x,y) (teban,bd) = (not teban,updt x y (if teban then Maru else Batsu) bd)

printBoard :: Board -> IO ()
printBoard (teban,bd) = do
  putStrLn $ (if teban then "maru" else "batsu") ++ " no teban"
  mapM_ putStrLn dat
  putStrLn ""
  where
    dat = intersperse "-----" [intersperse '|' $ map showElem l | l <- bd]
    showElem c
      | c == Maru  = 'o'
      | c == Batsu = 'x'
      | c == Blank = ' '

 ------------------

main = playGame initBoard

playGame bd@(teban,dat)
  | endGame bd = do
    printBoard bd
    case compare 0 (evalBoard bd) of
      EQ -> putStrLn "Draw!"
      LT -> putStrLn "Maru win!"
      GT -> putStrLn "Batsu win!"
  | otherwise  = do
    printBoard bd
    if teban
      then do
        te <- getInput dat
        playGame $ move te bd
      else do
        playGame $ move (bestHand bd) bd

getInput bd = do
  putStrLn "input coordinate:"
  s <- getLine
  let ns = words s
  if length ns /= 2 || not (all (all isDigit) ns)
    then getInput bd
    else
      let [x,y] = map read ns in
      if 1<=x&&x<=3&&1<=y&&y<=3&&bd!!(y-1)!!(x-1)==Blank
        then return (x-1,y-1)
        else getInput bd

どうにもあんまりすっきりしないコードになってしまった。
前半がゲームの処理、後半が入出力処理。
bestHandの部分がゲーム独立である。
非常に短いけど…というか、この部分が非常に短く書けるから
全体ももっと短く書けると思っていたのだが。
しかしまぁ、唯一アルゴリズムらしいところなので、
それが独立することはやはり良いのかもしれない。
これがもっと複雑なアルゴリズムになったら効果は大きくなるだろう。