１．三目並べ
オペレーショナル・モナドには、いくつかの例が紹介されてるが、その中から、三目並べ(Tic Tac Tow)を詳しく調べてみる。オペレーショナル・モナドの使用に当たっては、次のモジュールをロードしておく必要がある。
cabal install operational
三目並べは、二人が戦う対戦ゲームである。一方が盤面を見て次の手を打ち、次に、他方が盤面を見て次の手を打ち、どちらかが勝つか、引き分けになるまで、この動作を繰り返すこととなる。従って、このゲームの命令は、「盤面を読む」と「次の手を打つ」という二つの命令があればよさそうである。
これは、プログラムの冒頭で定義されている。
data PlayerI a where ReadBoard :: PlayerI Board PlayMove :: Int -> PlayerI Bool
ReadBoardとPlayMoveは代数的データ型（dataで定義）でのデータコンストラクタと呼ばれている。PlayerIのIはInstruction(命令)を意味している。簡単にいうと、プレイヤーが取れる命令は、ReadBoard（盤面を読む）とPlayMove（次の手を打つ）の二つである。それぞれの命令は、PlayerIを再帰的に読んでいる。ReadBoardはPlayerI Boardとなっている。ここで、PlayerIをInt -> PlayerI Boolで書き換えると、(Int -> PlayerI Bool) Boardとなる。さらに、PlayerIをPlayerI Boardで置き換えると(Int -> (PlayerI Board) Bool) Boardとなる。少し分かりにくくなってきたので、これを図示する。プレイヤーは二人いるので、自分と相手ということにし、それぞれについて、再帰的な命令を繰り返し使ったとすると、例えば、以下のものが得られる。
なんと、PlayerIはゲームの進行状況を示している。
ところで、haskellは純粋関数型のプログラミング言語である。変数に一度値を設定したら後から変えることはできない。ところで、盤面の状態はゲームの進行とともに変化してゆく。このように、変化するものは純粋関数型で記述することはできないので、Haskellでは特別な手段を許している。それがモナドである。現実の世界を表す時に使われる。
PlayerIを現実の世界に移したのが、次の型シノニムである。
type Player m a = ProgramT PlayerI m a
上述のシノニムPlayerは、PlayerIを現実の世界に移したプログラムである。この記述はオペレーショナル・モナドを用いるときの定型文である。
次に、命令も現実の世界に移さなければならないが、それは次のようになってる。
readBoard = singleton ReadBoard playMove = singleton . PlayMove
これも、オペレーショナル・モナドを用いるときの定型文である。
２．プレーヤの動作
ここで説明中のプログラムは、人間とコンピュータ(AIと呼んでいる)が戦うようになっている。人間側のプログラムを見ると次のようになってる。
playerHuman :: Player IO () playerHuman = forever $ readBoard >>= liftIO . printBoard >> doMove where -- ask the player where to move doMove :: Player IO () doMove = do liftIO . putStrLn $ "At which number would you like to play?" n <- liftIO getLine b <- playMove (read n) unless b $ do liftIO . putStrLn $ "Position " ++ show n ++ " is already full." doMove
上述のプログラムは、盤面の出力や入力名の催促などがあって、少し長いプログラムになっているが、基本的には、readBoardとplayMoveを繰り返していることが分かる（playMoveではすでに石が置かれているところは受け付けないことが分かる）。
コンピュータの方は、AIとうたっているが、ランダムに打つ場所を決めているだけで、同じように、readBoardとplayMoveとを繰り返している。
３．ゲームの状態
ゲームの状態は、レコード構文を用いて次のようになってる。
data GameState = Game { board :: Board, activePlayer :: Symbol }
ここで、盤面は
data Symbol = X | O deriving (Eq,Show) type Square = Either Int Symbol type Board = [[Square]]
とする。
ゲームの初期状態は次のようになってる。(先手はXである。これは人間)
initialGameState :: GameState initialGameState = Game (map (map Left) [[1,2,3],[4,5,6],[7,8,9]]) X
４．プログラムの解釈
プログラムは先頭の命令を取り出し、それを解釈するが、次のようになってる。
runGame :: Player IO () -> Player IO () -> IO () runGame player1 player2 = eval' initialGameState player1 player2 where eval' game p1 p2 = viewT p1 >>= \p1view -> eval game p1view p2 eval :: GameState -> ProgramViewT PlayerI IO () -> Player IO () -> IO () eval game (Return _) _ = return () eval game (ReadBoard :>>= p1) p2 = eval' game (p1 (board game)) p2 eval game (PlayMove mv :>>= p1) p2 = case makeMove mv game of Nothing -> eval' game (p1 False) p2 Just game' | won game' -> let p = activePlayer game in putStrLn $ "Player " ++ show p ++ " has won!" | draw game'-> putStrLn $ "It's a draw." | otherwise -> eval' game' p2 (p1 True)
今、プレイヤーをp1とする。p1がdoMoveを実行したとする。doMoveに対する処理は、パターン照合で選択される。パターン照合は、純粋世界の命令との照合となっているので、doMoveを受け取ると、PlayMoveが一致する。従って、次の部分が実行される。
eval game (PlayMove mv :>>= p1) p2 = case makeMove mv game of Nothing -> eval' game (p1 False) p2 Just game' | won game' -> let p = activePlayer game in putStrLn $ "Player " ++ show p ++ " has won!" | draw game'-> putStrLn $ "It's a draw." | otherwise -> eval' game' p2 (p1 True)
もし有効な打ち手であれば次が実行される。即ち、打ち手がp2へと移る。
| otherwise -> eval' game' p2 (p1 True)
なお、新しい手を打った時の新しい盤面の状態は次のプログラムで得られる。
makeMove :: Int -> GameState -> Maybe GameState makeMove k (Game board player) | not (k `elem` possibleMoves board) = Nothing -- illegal move | otherwise = Just $ Game (map (map replace) board) (switch player) where replace (Left k') | k' == k = Right player replace x = x switch X = O switch O = X
また、勝敗の判定は次のようになる。
won :: GameState -> Bool won (Game board _) = any full $ diagonals board ++ rows board ++ cols board where full [a,b,c] = a == b && b == c diagonals [[a1,_,b1], [_ ,c,_ ], [b2,_,a2]] = [[a1,c,a2],[b1,c,b2]] rows = id cols = transpose -- is the game a draw? draw :: GameState -> Bool draw (Game board _) = null (possibleMoves board)
５．課題１
コンピュータの打ち手を改良して、AIらしくしなさい。
６．課題２
オセロゲームを作成しなさい。
７．最後に
全てをまとめたプログラムは次のようになっている。
{------------------------------------------------------------------------------ Control.Monad.Operational Example: An implementation of the game TicTacToe. Each player (human, AI, ...) is implemented in a separate monad which are then intermingled to run the game. This resembles the PoorMansConcurrency.hs example. Many thanks to Yves Par`es and Bertram Felgenhauer http://www.haskell.org/pipermail/haskell-cafe/2010-April/076216.html ------------------------------------------------------------------------------} {-# LANGUAGE GADTs, Rank2Types #-} import Control.Monad import Control.Monad.Operational import Control.Monad.State import Data.Either import Data.List -- external libraries needed import System.Random {------------------------------------------------------------------------------ The Player monad for implementing players (human, AI, ...) provides two operations readBoard -- read the current board position playMove -- play a move to query the current board position and perform a move, respectively. Moreover, it's actually a monad transformer intended to be used over IO. This way, the players can perform IO computations. ------------------------------------------------------------------------------} data PlayerI a where ReadBoard :: PlayerI Board PlayMove :: Int -> PlayerI Bool type Player m a = ProgramT PlayerI m a readBoard = singleton ReadBoard playMove = singleton . PlayMove -- interpreter runGame :: Player IO () -> Player IO () -> IO () runGame player1 player2 = eval' initialGameState player1 player2 where eval' game p1 p2 = viewT p1 >>= \p1view -> eval game p1view p2 eval :: GameState -> ProgramViewT PlayerI IO () -> Player IO () -> IO () eval game (Return _) _ = return () eval game (ReadBoard :>>= p1) p2 = eval' game (p1 (board game)) p2 eval game (PlayMove mv :>>= p1) p2 = case makeMove mv game of Nothing -> eval' game (p1 False) p2 Just game' | won game' -> let p = activePlayer game in putStrLn $ "Player " ++ show p ++ " has won!" | draw game'-> putStrLn $ "It's a draw." | otherwise -> eval' game' p2 (p1 True) -- example: human vs AI main = do g <- getStdGen runGame playerHuman (playerAI g) {------------------------------------------------------------------------------ TicTacToe Board type and logic The board looks like this: +---+---+---+ some squares already played on | 1 | 2 | 3 | the empty squares are numbered +---+---+---+ | 4 | 5 |OOO| +---+---+---+ | 7 |XXX| 9 | +---+---+---+ ------------------------------------------------------------------------------} data Symbol = X | O deriving (Eq,Show) type Square = Either Int Symbol type Board = [[Square]] data GameState = Game { board :: Board, activePlayer :: Symbol } initialGameState :: GameState initialGameState = Game (map (map Left) [[1,2,3],[4,5,6],[7,8,9]]) X -- list the possible moves to play possibleMoves :: Board -> [Int] possibleMoves board = [k | Left k <- concat board] -- play a stone at a square makeMove :: Int -> GameState -> Maybe GameState makeMove k (Game board player) | not (k `elem` possibleMoves board) = Nothing -- illegal move | otherwise = Just $ Game (map (map replace) board) (switch player) where replace (Left k') | k' == k = Right player replace x = x switch X = O switch O = X -- has somebody won the game? won :: GameState -> Bool won (Game board _) = any full $ diagonals board ++ rows board ++ cols board where full [a,b,c] = a == b && b == c diagonals [[a1,_,b1], [_ ,c,_ ], [b2,_,a2]] = [[a1,c,a2],[b1,c,b2]] rows = id cols = transpose -- is the game a draw? draw :: GameState -> Bool draw (Game board _) = null (possibleMoves board) -- print the board showSquare = either (\n -> " " ++ show n ++ " ") (concat . replicate 3 . show) showBoard :: Board -> String showBoard board = unlines . surround "+---+---+---+" . map (concat . surround "|". map showSquare) $ board where surround x xs = [x] ++ intersperse x xs ++ [x] printBoard = putStr . showBoard {------------------------------------------------------------------------------ Player examples ------------------------------------------------------------------------------} -- a human player on the command line playerHuman :: Player IO () playerHuman = forever $ readBoard >>= liftIO . printBoard >> doMove where -- ask the player where to move doMove :: Player IO () doMove = do liftIO . putStrLn $ "At which number would you like to play?" n <- liftIO getLine b <- playMove (read n) unless b $ do liftIO . putStrLn $ "Position " ++ show n ++ " is already full." doMove -- a random AI, -- also demonstrates how to use a custom StateT on top -- of the Player monad playerAI :: Monad m => StdGen -> Player m () playerAI = evalStateT ai where ai :: Monad m => StateT StdGen (ProgramT PlayerI m) () ai = forever $ do board <- lift $ readBoard n <- uniform (possibleMoves board) -- select a random move lift $ playMove n where -- select one element at random uniform :: Monad m => [a] -> StateT StdGen m a uniform xs = do gen <- get let (n,gen') = randomR (1,length xs) gen put gen' return (xs !! (n-1))
