Haskell で三目並べ (1)

Haskell の Monad transformer が大体わかってきたので、State と IO を組み合わせる練習コードを書いてみる。題材として、三目並べ（Tic-Tac-Toe）を選んでみた。

こんな仕様でやってみる。

• コンソールアプリとする
• 実行時引数で"m"を渡したらマシン、でなければユーザの先手
• 0から8の文字で位置を指定する（左上が0、Enter不要）。
• 不正入力時、その旨表示して再入力を促す。
• マシン／ユーザ双方の指し手の後に盤面を表示する。
• 決着が着いたら、結果を表示する

====

◆ 盤面の表現

盤面は九つのマスから成り、それぞれ U(ユーザ)か M(マシン)か空のいずれかの状態

data Mark = User|Machine|Blank deriving Eq
instance Show Mark where
  show User    = "U"
  show Machine = "M"
  show Blank   = " "

type Board = [Mark]

initialBoard :: Board
initialBoard = take 9 $ repeat Blank

下記のような関数で、盤面を文字列化してコンソールに表示できる。（LU は Data.List.Utilsのエイリアス）

printBoard :: Board -> IO ()
printBoard board =
    putStrLn $ unlines $ LU.join ["-+-+-"] $ map showRow [0..2]
  where
    showRow row = [LU.join "|" $ map show $ cells row]
    cells   row = take 3 $ snd $ splitAt (row * 3) board

タテ、ヨコ、ナナメの列を表すためのインデクスの配列は以下のように書いた。計算で導出することもできるけど、却ってわかりにくかったの明示的な定数として書き直した。

rows :: [[Int]]
rows = [[0,3,6],[1,4,7],[2,5,8],
        [0,1,2],[3,4,5],[6,7,8],
        [0,4,8],[2,4,6]]

◆ ゲームの流れの表現

main は、先手を判別してゲームを開始し、結果を表示する。

main :: IO ()
main = do
    args <- getArgs
    let machineFirst = 0 < length args && "m"==args!!0
    evalStateT (play machineFirst) initialBoard >>= putStrLn

play が実際のゲームを進行する関数で、状態としての盤面を保持しながらユーザ入力を受け付けたりする。というわけで型としては State Board と IO を組み合わせた StateTになっている。

ユーザの指し手とマシンの指し手を交互に取得しながら、盤面の状態を更新・再表示した上で勝敗を判定。決着が着けばこれを結果とし、着かなければ play に再帰するという形になる。

play :: Bool -> StateT Board IO String
play isMachinesTurn = do
    if isMachinesTurn then machinesTurn
                      else usersTurn
    board <- get
    liftIO $ printBoard board
    case judge board of
        Nothing     -> (play $ not isMachinesTurn)
        Just result -> return result

judge :: Board -> Maybe String
judge board
    | wonBy User board                 = return "won by user."
    | wonBy Machine board              = return "won by machine."
    | Nothing == elemIndex Blank board = return "drawn."
    | otherwise                        = Nothing

wonBy :: Mark -> Board -> Bool
wonBy mark board = any threeInRow rows
  where
    threeInRow indices = all (mark==) $ rowStates indices
    rowStates indices  = map (board!!) indices

◆ ユーザの指し手の取得

標準入力から一文字取得して、指し手を得る。既にマークのあるマスに置こうとしたり、0〜8以外のキーを押下するとエラー。問題なければ盤面を更新して、得られた指し手を結果とする。

usersTurn :: StateT Board IO Int
usersTurn = do
    position <- liftIO getDigit
    board    <- get
    if Blank /= board!!position
        then (liftIO $putStrLn "wrong position") >> usersTurn
        else updateBoard User position >> return position
  where
    getDigit = do 
        ch <- getChar
        putStrLn ""
        if elem ch ['0'..'8']
            then return (read [ch])
            else putStrLn "wrong input" >> getDigit

盤面の更新はこんな関数を使う。update 関数は、後で 非Monad な文脈でも使えるように切り出した。

updateBoard :: Mark -> Int -> StateT Board IO ()
updateBoard mark pos = get >>= put.(update mark pos)

update :: Mark -> Int -> Board -> Board
update mark pos board =
    let (f, (x:xs)) = splitAt pos board in f ++ (mark:xs)

◆ マシンの指し手の決定（暫定）

長くなってきたので、詳細は後で別に書くことにして、盤上左上から開いているマスを探して見つかり次第返すだけの暫定実装で、とりあえず動かしてみる。

machinesTurn :: StateT Board IO Int
machinesTurn = do
    board <- get
    let idx = fromJust $ elemIndex Blank board
    updateBoard Machine idx
    return idx

ここまでのコードを、適切に import 文を追加した上で一個のファイルにまとめて、ghci に読ませると、プロンプトから下のように実行できる。

ghci> :main
0
U| | 
-+-+-
 | | 
-+-+-
 | | 

U|M| 
-+-+-
 | | 
-+-+-
 | | 

4
U|M| 
-+-+-
 |U| 
-+-+-
 | | 

U|M|M
-+-+-
 |U| 
-+-+-
 | | 

8
U|M|M
-+-+-
 |U| 
-+-+-
 | |U

won by user.
ghci> 

◆ ここまでのまとめ

まあ、マシン側の指し手が全く勝つ気も守る気もない暫定実装だけど、ここまででも一応、対話的に入力を受け付けながら状態を管理していくやり方が、だいたいわかった。もっと上達した後に見直したら、いろいろツッコミどころがあるんだろうけど、とりあえず先に進んでみる。